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INTRODUCTION 


BACKGROUND 

The  Navy  has  the  responsibility  of  providing  both  general  and  specialized 
operation  and  maintenance  training  for  their  personnel.  To  impart  the 
necessary  information  the  Navy  relies  heavily  on  technical  documents  for 
training  and  for  on  the  job  maintenance  functions.  Two  studies  conducted  by 
the  General  Accounting  Office  (GAO  1977  and  GAO  1979)  indicated  much  pertinent 
technical  material  is  written  at  a  higher  reading  grade  level  than  enlisted 
personnel  can  comprehend.  In  an  attempt  to  deal  with  this  problem,  the  Chief 
of  Naval  Education  and  Training  (CNET),  in  1978,  tasked  the  Training  Analysis 
and  Evaluation  Group  (TAEG)  to  undertake  the  development  of  the  Computer 
Readability  and  Editing  System  (CRES).' 

The  CRES  system  analyzes  the  sentence  construction  of  various  reading 
materials  and  determines  the  reading  grade  level  as  defined  by  the  Department 
of  Defense  Military  Specification  MIL-M-38784B.  In  addition,  the  system 
provides  suggestions  for  simplification  and  clarification  of  the  material. 

The  original  development  and  testing  of  the  CRES,  along  with  detailed  examples 
of  its  use,  are  described  in  Development  and  Test  of  a  Computer  Readability 
Editing  System  (CRES)  (Kincaid,  Aagard,  and  O'Hara,  1980).  This  original 
development  was  done  on  a  Wang  2200MVP  computer. 

In  October  1983  a  team  was  formed  to  continue  this  development,  expanding 
the  scope  and  improving  the  accuracy  of  the  program.  The  new  CRES  was  to  be 
implemented  on  a  Wang  VS100  computer.  This  effort  produced  the  current  CRES; 
an  updated,  expanded,  and  enhanced  version  written  in  Wang  VS  BASIC.  Figure  1 
identifies  key  components  of  CRES  and  illustrates  their  interrelations. 

PURPOSE 

This  report  provides  a  detailed  description  of  the  organization  of  the  VS 
BASIC  version  of  CRES,  including  the  various  programs  and  oata  files 
comprising  the  system.  Flowcharts  are  included  for  all  systems.  In  the  case 
of  three  categories  of  programs  the  flowcharts  are  essentially  the  same  for 
the  various  CRES  subsystems:  those  to  create  and  maintain  word  lists,  those 
to  print  the  word  lists,  and  those  to  print  the  word  lists  by  specified 
attribute  or  combination  of  attributes.  In  these  cases  a  single  sample 
flowchart  is  provided  for  each  genre.  The  intent  of  this  documentation  is  to 
assist  programmers  in  converting  CRES  from  Wang  VS  BASIC  to  other  computer 
languages  or  in  the  implementation  of  future  modifications. 


CNET  Code  N-5  letter  of  Z9  June  1978. 
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ORGANIZATION  OF  THE  REPORT 

In  addition  to  this  introduction,  the  report  is  divided  into  two  other 
sections  and  four  appendices.  The  first  section  briefly  describes  the  CRES 
and  its  major  options  and  suboptions.  The  next  section  provides  a  detailed 
description  of  the  individual  programs  comprising  the  system  and  a  commented 
listing  for  each  program.  Appendix  A  contains  the  word  list  definitions  and 
the  control  file  describing  each  word  list  data  file.  Appendix  B  contains  a 
list  of  all  the  programs  and  data  files  included  in  the  CRES,  along  witn  their 
library  and  volume  locations.  Appendix  C  contains  sample  flowcharts  for  tne 
programs  to  create  and  maintain  the  word  lists,  to  print  the  word  lists,  and 
to  print  the  word  lists  by  a  specified  attribute  or  combination  of 
attributes.  Appendix  D  contains  a  sample  text  passage  and  the  output  obtained 
from  a  CRES  analysis  of  the  text. 
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OVERVIEW  OF  THE  COMPUTER  READABILITY  AND  EDITING  SYSTEM 

The  ORES  supports  the  generation  of  a  readability  analysis  for  a  given 
text,  the  generation  of  editorial  suggestions  for  simplifying  and  clarifying 
the  text,  the  creation  of  a  glossary  of  technical  terms  and  their  definitions 
for  reference  purposes,  and  the  creation  and  maintenance  of  word  and  phrase 
lists  to  be  used  in  the  CRES  analysis.  Further  information  on  the  usage  of 
CRES  can  be  found  in  Computer  Readability  Editing  System  (CRES)  for  Writers 
and  Editors  (Kincaid,  Pierce,  in  press). 

SUBSYSTEMS 

Figure  2  depicts  the  organization  of  the  CRES  and  the  interconnection  of 
the  various  subsystems  which  is  achieved  through  a  chain  of  menus.  The  system 
is  comprised  of  seven  distinct  subsystems: 

1  -  The  Common  Word  List  Subsystem 

2  -  The  Technical  Word  List  Subsystem 

J  -  The  Word  and  Phrase  Substitute  Subsystem 

4  -  The  Glossary  Subsystem 

5  -  The  Root  Word  Expansion  Subsystem 

o  -  The  Analysis  Subsystem 

7  -  The  Copy  Word  Lists  to  Tape  Subsystem 

The  Common  Word  List  Subsystem  enables  the  user  to  create,  modify,  or 
print  out  the  Common  Word  List.  The  Common  Word  List  is  a  compilation  of 
words  which  are  considered  familiar  and  which  frequently  occur  in  ordinary 
usage.  These  words  are  defined  as  "common".  When  text  is  analyzed,  each  word 
is  checked  against  this  list;  words  not  appearing  on  the  Common  Word  List  are 
considered  "uncommon"  words  and  will  be  flagged  as  such.  At  tne  present  time, 
the  Common  Word  List  is  comprised  of  approximately  4000  root  words  and  tneir 
expansions,  yielding  approx imately  11,000  words.  A  list  of  all  words 
contained  in  the  Common  Word  List  can  be  found  in  Word  Lists  to  Limit 
Vocabulary  in  Technical  Information  (Kincaid,  McDaniel,  Pierce,  1986). 

The  Technical  Word  List  Subsystem  enables  the  user  to  create,  modify,  or 
print  out  the  various  technical  word  lists.  A  technical  word  list  enables  a 
user  to  specify  certain  technical  words  which,  altnough  uncommon  in  ordinary 
usage,  are  commonly  encountered  in  a  particular  area.  They  should  be 
considered  common  in  any  document  pertaining  to  that  area.  In  conducting  a 
CRES  analysis,  the  user  is  given  the  opportunity  to  specify  up  to  seven 
different  technical  word  lists.  At  the  present  time,  the  system  includes 
Administrative/Clerical;  Aircraft  Equipment;  Communication/Navigation;  General 
Electronics;  Hull,  Mechanical,  and  Electrical;  Propulsion  Engineering;  and 
Weapon  System  Control  Technical  Word  Lists.  Any  or  all  of  these,  or  any 


Figure  l.  CRES  system  diagram 
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additional  list(s)  created  by  the  user  through  the  Technical  Word  List 
Subsystem,  may  be  specified  for  inclusion  in  an  analysis.  Any  lists  specified 
are  considered  as  supplements  to  the  Common  Word  List  for  the  purposes  of  tnat 
analysis,  and  any  words  appearing  on  them  will  be  considered  to  be  "common". 

A  copy  of  each  of  the  technical  word  lists  has  been  published  (Kincaid,  et  al, 
1985). 

The  Word  and  Phrase  Substitute  Subsystem  enables  the  user  to  create, 
modify,  or  print  out  the  Word  Substitution  List  or  the  Phrase  Substitution 
List.  These  lists  provide  up  to  two  suggested  substitutes  for  the  given  word 
or  phrase.  If  requested  by  the  user,  these  suggested  substitutes  will  be 
provided  in  the  CRES  analysis. 

The  Glossary  Subsystem  enables  the  user  to  create,  modify,  or  print  out 
any  glossaries  desired.  There  are  two  different  types  of  glossaries  treated 
in  this  system,  which  are  useful  adjuncts  to  the  text  when  writing  technical 
material.  The  first  is  an  Abbreviation-Acronym  Glossary,  which  contains 
various  abbreviations,  acronyms,  and  their  definitions.  This  glossary  is 
consulted  by  the  Analysis  Subsystem.  The  second  is  a  Technical  Glossary, 
which  is  comprised  of  various  technical  terms  and  their  definitions.  This  is 
included  exclusively  for  the  user's  reference  and  is  not  utilized  by  any  other 
part  of  the  CRES. 

The  Root  Word  Expansion  Subsystem  enables  the  user  to  expand  any  root  word 
as  required  and  to  merge  these  expansions  into  the  Common  Word  List  or  into  a 
technical  word  list. 

The  Analysis  Subsystem  enables  the  user  to  perform  a  CRES  analysis  of  any 
VS  word  processing  document.  The  user  has  the  capability  to  specify  various 
options,  including  calculation  of  the  reading  grade  level  and  the  flagging  of 
various  characteristics  which  raise  the  reading  grade  level. 

The  Copy  Word  Lists  to  Tape  Subsystem  enables  the  user  to  transfer  to  tape 
any  or  all  of  the  CRES  word  lists. 

WORD  LISTS 

The  CRES  Analysis  Subsystem  depends  on  many  word  lists.  Appendix  A 
contains  the  data  file  definition  and  the  control  file  for  each  of  these 
lists.  The  following  is  a  brief  discussion  of  the  different  types  of  word 
lists,  and  the  naming  conventions  used: 

CMNWDLST  :  This  is  the  Common  Word  List.  This  list  contains  the  words 

considered  to  be  "common"  words,  (familiar  and  frequently 
occurring),  with  their  parts  of  speech  and  other  pertinent 
information.  There  are  approximately  11,000  entries  in  the 
current  list. 


15 
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WRDSBLST  :  This  is  the  Word  Substitution  List.  This  list  consists  of 

words  considered  to  be  awkward  or  unnecessarily  difficult, 
with  one  or  two  suggested  substitutes  for  each  word.  A 
substitute  can  be  any  word  or  phrase  of  30  characters  or 
less. 

PHRSBLST  :  This  is  the  Phrase  Substitution  List.  This  list  consists 

of  phrases  considered  to  be  awkward  or  unnecessarily 
difficult,  with  one  or  two  suggested  substitutes  for  eacn 
phrase.  A  substitute  can  be  any  word  or  phrase  of  34 
characters  or  less. 

ABBRELST  :  This  is  a  list  of  common  abbreviations  and  acronyms,  and 

their  definitions. 

GLOSSARY  :  Th;s  is  an  optional  file  used  to  contain  any  desired  words 

and  their  definitions.  It  can  be  printed  out  for 
reference,  but  it  is  not  utilized  in  the  analysis. 

In  the  development  of  CRES,  there  were  seven  different  technical  word 
lists  established  for  testing  and  evaluation.  Each  technical  word  list 
contains  words  that,  while  they  might  be  unusual  to  a  novice,  represent  common 
terminology  to  someone  more  familiar  with  the  subject  area.  These  words  would 
not  be  flagged  as  uncommon  if  the  technical  word  list  containing  them  is 
specified  for  use  in  the  analysis.  The  lists  provided  are  as  follows: 

ADMCLER  :  Administrative  and  Clerical  Word  List  (391  root  words,  6U7 

total  words) 

AiREOUl  :  Aircraft  Equipment  Word  List  (189  root  words,  3b7  total 

words ) 

■  i  )MMN/V»  :  common  i(  .it.  ions  and  Navigation  Word  List  (413  root  words, 

77U  total  words) 

GENELCT  :  General  Electronics  Word  List  (389  root  words,  669  total 

words ) 

HMELUT  :  Ships'  Mechanical  and  Electrical  Word  List  (471  root  words, 

919  total  words) 

PR0PEN6  :  Propulsion  Engineering  Word  List  (443  root  words,  88b  total 

words ) 


WGOON  I  : 


Weapon  Systems  Control  Word  List  (3/b  root  words,  8ob  total 
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The  CRES  system  supports  the  maintenance  of  existing  lists,  and  the 
creation  of  new  lists  where  required.  Each  installation  is  encouraged  to 
develop  its  own  word  lists,  as  well  as  to  modify  and  use  the  seven  lists 
provided . 

INSTALLATION  AND  OPERATION 

The  CRES  is  designed  to  be  implemented  on  the  Wang  VS  system,  running  on 
Wang  Operating  System  Release  5.03. 10A  or  later.  It  requires  a  standard  VS 
configuration,  including  a  workstation,  line  printer,  and  disk  drive  with  at 
least  5MB  of  disk  storage. 

In  order  to  run  the  CRES,  certain  Wang  utilities  are  required.  The  object 
code  for  these  programs  must  be  placed  in  library  l?SYSS AV(d  on  the  volume  where 
the  CRES  system  resides.  The  following  is  a  list  of  the  required  utilities: 

DISMOUNT 

DISPLAY 

EXTRACT 

LINK 

MOUNT 

READEDK 

REAuVTOC 

SCRATCH 

In  addition,  the  object  code  for  the  word  processing  subroutine  program, 
WPSBRTNB,  must  be  placed  i'  library  @LINKLIB  on  the  volume  where  CRES  resides. 

At  the  time  of  installation,  it  is  necessary  for  a  programmer  to  provide 
the  name  of  the  volume  where  the  CRES  will  reside.  The  following  steps  are 
requi red : 

1  -  Edit  program  CRES  in  library  CREStdPRC  on  the  desired  volume  name. 

2  -  On  line  number  2000,  the  variable  &CARV0L  is  currently  initialized  to 
CRESOO.  This  initial  value  must  be  changed  to  the  desired  volume  name  for  the 
CRES  volume. 

3  -  After  this  change  has  been  made,  the  input  file  (filename  IKES  in 
library  CRESOPRC  on  the  CRES  volume)  must  be  replaced  with  the  edited  file. 

To  operate  the  CRES,  run  filename  CRES  in  library  CRESlPPRt  on  the  volume 
on  which  CRES  resides.  This  produces  the  CRES  Master  Menu,  from  which  any 
subsystem  can  be  selected.  (See  Figure  2.)  It  is  advisable  to  establish  a 
logon  procedure  to  run  CRES,  and  to  assign  this  logon  procedure  to  those  users 
who  will  be  running  the  system. 
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Detailed  instructions  for  the  operation  of  the  CRES  can  be  found  in  the 
Computer  Readability  and  Editing  System  (CRES):  User's  Reference  Manual  (S.  R. 
Schalow  and  J.  E.  Mears,  in  press). 

CRES  ANALYSIS  SUBSYSTEM  CONVENTIONS 

The  CRES  Analysis  Subsystem  will  perform  a  CRES  analysis  on  any  text  that 
is  in  word  processing  document  format.  Any  particular  portion  of  text  in  the 
document  to  be  excluded  from  the  analysis  must  be  surrounded  by  the  characters 

.  An  sign  must  immediately  precede  the  text  to  be  excluded,  and 

another  "@0"  sign  must  immediately  follow,  signaling  the  analysis  to  resume. 

The  Analysis  Subsystem  supports  a  defaults  file  for  each  user.  This 
defaults  file  holds  the  names  of  technical  word  lists  to  be  used  (displayed  on 
the  Technical  File  Selection  Screen)  and  analysis  options  selected  (displayed 
on  the  Option  Selection  Screen)  for  each  user.  After  tne  defaults  file  is 
established  for  a  particular  user,  the  analysis  program  is  initialized  to  that 
user's  defaults  on  subsequent  analyses.  If  the  defaults  are  not  satisfactory, 
the  user  can  change  them  for  any  particular  session  when  running  an  analysis. 
If  a  defaults  file  does  not  already  exist  for  a  given  user,  the  Analysis 
Subsystem  is  designed  to  create  one,  which  will  contain  the  options  selected 
by  the  user  for  the  first  CRES  analysis  performed.  The  filename  is  formed  by 
the  User  ID  concatenated  with  the  string  "DFlTS" ,  and  is  stored  in  library 
CRESMDAT.  The  user  can  permanently  change  the  defaults  by  scratching  the 
defaults  tile.  Trie  program  will  then  recreate  the  file  in  the  next  analysis 
run,  using  the  new  options  selected  for  future  defaults. 

The  system  can  support  multiple  users  although,  if  multiple  analyses  are 
being  run,  each  analysis  must  be  examining  a  different  document.  To  avoid  the 
possibility  of  more  than  one  user  accessing  a  word  simultaneously  during 
ru i ntpriunce  of  the  word  lists,  a  protection  system  has  been  implemented, 
d'-  itrct  ton  bytes  are  set  in  the  record  of  a  word  when  it  is  called  up  for 
"biting.  If  another  user  tries  to  access  the  word  while  the  protect  bytes  are 
’"t,  a  messaqe  will  be  presented  to  this  effect.  Wnen  the  editing  of  the  word 
ms  been  completed,  t tie  oytes  are  reset  to  zero.  This  process  is  ordinarily 
transparent  to  the  user.  However,  in  the  case  of  a  system  crash  or  a  power 
t  :  i  lure,  it  would  be  possible  for  the  protect  bytes  to  remain  set.  Should 
tots  nappen,  capability  has  been  provided  to  reset  the  protect  bytes  by  use  of 
the  appropriate  option  on  the  editing  subsystem  menu. 


Tne  following  section  of  this  manual  provides  the  detailed  descriptions 
bid  listings  of  trie  programs  in  the  System. 
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THE  COMPUTER  READABILITY  AND  EDITING  SYSTEM  (CRES) 

This  section  contains  the  listings,  including  comments,  for  the  programs 
comprising  the  CRES  and  necessary  explanatory  notes.  Flowcharts  are  included 
with  specific  programs,  except  in  the  case  of  programs  to  create  and  maintain 
a  word  list,  to  print  a  word  list,  or  to  print  a  word  list  by  attribute. 

Sample  flowcharts  for  these  three  types  of  programs  are  included  in  appendix  C 

The  programs  are  written  primarily  in  VS  BASIC,  with  the  exception  of  the 
menus.  Those  are  written  in  VS  Procedure  Language.  A  number  of  the  CRES 
programs  have  occasion  to  call  Wang  VS  utility  programs,  such  as  "DISMOUNT", 
"DISPLAY",  "EXTRACT",  "LINK",  "MOUNT",  "READFDR " ,  "READVTOC ",  and  "SCRATCH". 
The  code  for  these  utilities  is  only  available  from  Wang  Laboratories, 
Incorporated,  and  no  discussion  of  them  can  be  provided  in  this  document. 

The  programs  contained  in  this  section  are  organized  in  the  same  order  as 
in  the  Master  Menu. 
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MASTER  MENU  (CRES) 

CRES  in  library  CREStaPRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  entire  CRES  system.  It  enables  the  user  to 
select  by  PF  key  among  options  to  enter  the  Common  Word  List  Subsystem,  the 
Technical  Word  List  Subsystem,  the  Substitution  Lists  Subsystem,  the  Glossary 
Subsystem,  the  Analysis  Subsystem,  and  the  Copy  Word  Lists  to  Tape  Subsystem, 
or  to  end  CRES  processing. 

A  complete  listing  follows. 
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Wang 

VS  Integrated 

Editor  -  Version 

6.10.00 

15:59 

09  / 1 9/84 

Page 

Input 

File  is  CRES 

in  Library 

CRES^PRC  on  Vo 

lump  ...  t 

SOO 

* 

PROCEDURE 

CRES  MASTER 

MENU 

BP 

RT 

* 

AUTHOR 

ROSE  TANK 

RT 

* 

DATE 

10/06/83 

RT 

* 

BP 

★ 

Abstract : 

This  procedure 

is 

the  CRES  MASTER  MENU  . 

RT 

* 

It  a  1  lows  the 

user  to  select 

and  run 

any 

RT 

★ 

file  option. 

BP 

* 

BP 

DECLARE 

&RNUOM 

AS 

STRING 

(1) 

INITIAL 

u  m 

DECLARE 

4USER1NPT 

AS 

INTEGER 

INlliAL 

0 

BP 

DECLARE 

40PT IONERR 

AS 

STRING 

(79) 

INITIAL 

n 

■'  RT 

DECLARE 

4  OPT  IONERR? 

AS 

STRING 

(79) 

INITIAL 

ii 

"  RT 

DECLARE 

4USERNAME 

AS 

STRING 

(24) 

INITIAL 

H 

"  BP 

DECLARE 

4ERRMSG 

AS 

STRING 

(34) 

INITIAL 

ii 

“  BP 

DECLARE 

4RUNLI8 

AS 

STRIN6 

(8) 

INITIAL 

ii 

"  RT 

DECLARE 

4RUNV0L 

AS 

STRING 

(6) 

INITIAL 

ii  H 

DECLARE 

4SUNLIB 

AS 

STRING 

(8) 

INITIAL 

ii 

"  RT 

OECLARE 

4  SUN  VOL 

AS 

STRING 

(6) 

INITIAL 

JM 

★ 

JM 

*  & CAR  VOL  IS  T  ME (VARIABLE  THAT  NEE  OS  TO  8E  ALTEREO  IN  LINE  2000.  JM 

*  REPLACE  "CRESOO"  WITH  THE  NAME  OF  THE  VOLUME  AT  YOUR  INSTALLATION.  JM 

*  DON'T  FORGET  TO  REPLACE  THE  INPUT  FILE  (CRES  IN  CRESOPRC  ON  YOUR  JM 

*  VOLUME),  WHICH  NOW  HAS  YOUR  VOLUME  NAME  INITIALLY.  JM 

*  JM 


ncrri  apf 

(tfARVOI 

AS 

STRING 

(6) 

INITIAL 

"CRESOO" 

JM 

DECLARE 

45  INVOL 

AS 

STRING 

(6) 

INITIAL 

DECLARE 

4SINLIB 

AS 

STRING 

(8) 

INITIAL 

RT 

OECLARE 

4SOTVOL 

AS 

STRING 

(65 

INITIAL 

II  II 

DECLARE 

4S0TLI8 

AS 

STRING 

(8) 

INITIAL 

RT 

DECLARE 

4SRNLIB 

AS 

STRING 

(8) 

INITIAL 

II  ■■ 

RT 

OECLARE 

4SRNV0L 

AS 

STRING 

(6) 

INITIAL 

II  II 

DECLARE 

4WRKV0I 

AS 

STRING 

(6) 

INITIAL 

OECLARE 

4SP0LIB 

AS 

STRING 

(6) 

INITIAL 

11 

RT 

DECLARE 

4SP0V0L 

AS  STRING 

(6) 

INITIAL 

* 

EXIRACT  &SRNL  IB  -  RUNL1B,  4SRNV0L=RUNV0L,  4SINL  1  B=  INL  IB,  RT 

& S I NVOL  =  INVOL,  4S0TV0L  =  OUTVOL,  &SOT L I B=OUTL 1 8 , 

4WRKV0L  =  WORKVOL,  4SP0L IB  =  SPOOLIB,  45P0V0L  =  SPOOLVOt  ,M 

JM 

RT 

SET  INLIB=CRES@OAT,  INV0L=4CARV0L,  OUTL  I8=CRES(5»SAV.  JM 

IXITVOL  =4CARV0L  ,  RUNL  I  B  =  CRESE*PRC ,  RUNVOL =4CARV0L ,  JM 

WOR  K  VOL  *4C  ARVO!  ,  SPOOL  VOL *&CARVOL ,  SPOOL  I B  =  CRE  SPPRT  JM 

JM 
K  1 

EX  TRAC  I  &USERNAME  =  USERNAME ,4RUNL IB  <=  RUNL  IB ,  4RUNV0L  =RUNVOL ,  RT 


4SUNLIB  =  OUTL  IB,  4SUNV0L  =  OUTVOL 

*  BP 

GE  T  USER  1 NPT :  PROMPT  PFKEY  =  &  USER  1 NP  T  CENTER  RT 

DIM  "C RES:  Computer  Readability  4  Editing  System  RT 

(Master  Menu  Screpn)";  R1 

DIM  "^  =  ======  ====:======  =  5=  =  S========  =  ==,=  =====  =  =  =  =  =  =  =  =  =  =  ===  kt 

=  =  *  =  =  =  ,  =  RT 

OIM  "  RT 


DIM  "  He l  lo,", bright  4USERNAME( 1 ,*) Welcwtie  to  the  CRES  Ma  RT 


I 


0001 00 
000200 
000300 
00  0400 
000500 
000600 
000700 
000800 
000000 
00 1000 
001100 
001200 
001300 
001400 
001500 
001600 
001700 
001800 
001900 
001910 
001920 
00)930 
001940 
0019  50 
001955 
002000 
0J2 IUU 
002200 
002  300 
0024  00 
002  500 
002600 
0027  00 
002600 
0029  00 
003000 
003)00 
003200 
003300 
003400 
003500 
003600 
0037  00 
003800 
003900 
004000 
004100 
004  200 
004300 
004400 
004  500 
00  4  600 
0047  00 
004  8  00 
004900 
005000 
005100 
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Wang  VS  Integrated  Iditnr  -  Version 

6. 

10.00  15:59  09/18/84 

Pag. 

2 

Input  File  is  CRES  in  Library  CRES@PRC  on  Vulune  CRESOO 

ster  Menu,  your  quide  through 

RT 

DOS  200 

DIM  "  the  Computer  Readability 

& 

Editing  System.”; 

RT 

005300 

DIM  "  Select  the",  BRIGHT  "  PF 

key","  corresponding  to  your  desir 

RT 

005400 

ed  operation."; 

RT 

005500 

DIM  " 

BP 

005600 

DIM  "  ".LINE  "PF 

".DIM  "  ", 

RT 

0  0  57  00 

lift  "  Operation 

"  ; 

RT 

005800 

DIM  "  *'; 

BP 

005900 

n  1 M  "  ".Rnqht 

“1“ 

-  Ccpatfv'Mai  nt  a*  n  Condon 

Wnrd 

RT 

006000 

list"; 

RT 

006100 

DIM  "  ".Bright 

"2" 

-  Create/Maintain  Technical  W 

RT 

006200 

ord  List"; 

RT 

006300 

DIM  "  ".Bright 

"3" 

,"  -  Create/Maintain  Substitutio 

RT 

006400 

n  Lists"; 

006500 

DIM  "  ".Bright 

"4" 

,"  -  Maintain  Glossaries"; 

RT 

006600 

DIM  "  ".Bright 

"S" 

, "  -  Expand  Root  Words"; 

RT 

0067 00 

DIM  "  ".Bright 

"6" 

-  Analyze  Word  Processing 

Doc 

RT 

006800 

ument  S" ; 

006900 

DIM  "  “.Bright 

"7" 

, “  -  Copy  Word  Lists  to  Tape 

"  ; 

BP 

007  000 

DIM  "  "; 

007  1 00 

DIM  "  i  ".Bright  " 

16“ 

-  End  CRES  Processing"; 

RT 

007  200 

BRIGHT  &0PTI0NERR; 

RT 

007  300 

BUNK  &0PT  I0NERR2  ; 

RT 

007  400 

♦ 

BP 

007  500 

ASSIGN  &ERRMSG  =  "  " 

BP 

007600 

1  lUi'tLiut  - 

L»  1 

n  «  r\ 

/  tn. 

ASSIGN  &0PTI0NERR2  -  " 

" 

RT 

007  8  0  0 

* 

BP 

007900 

IF  &USER  I NPT  EQ  16 

GOTO  USERLOG 

BP 

008000 

IF  &USERINPT  EQ  32 

GOTO  USERLOG 

BP 

008100 

IF  &USER I NPT  EQ  1 

GOTO  RUNCMW 

RI 

008200 

IF  &USERINPT  EQ  2 

GOTO  RUNSWL 

RT 

008300 

IF  MISER  I NP  T  EQ  3 

GOTO  RUNWSL 

RT 

008400 

IF  MISER INI’I  EQ  A 

GOTO  RUNBCG 

RT 

008500 

IF  &USERINPT  EQ  5 

GOTO  RUNERW 

RT 

008600 

If  &  USE  R I  NP  T  I  Q  6 

GOTO  RUNATF 

RT 

0087  00 

IF  &USERINPT  Eg  7 

GOTO  RUNCTP 

RT 

008800 

IF  &  USER  INPT  EQ  17 

GOTO  RUNCMW 

RT 

008900 

IF  MJSERINP1  E(J  16 

GOTO  RUNSWL 

RT 

009  0  00 

IF  &USERINPT  EQ  N 

GOTO  RUNWSL 

RT 

009100 

IF  tUSERINPI  FQ  20 

GOTO  RUNBCG 

RT 

009  200 

IF  MJSERINPI  K)  21 

GOTO  RUNERW 

RT 

009  300 

IF  MJSERINPT  EQ  22 

GOTO  RUNATF 

RT 

009400 

IF  MJSERIi.PT  EQ  23 

GOTO  RUNCTP 

RT 

009  500 

009  600 

ASSIGN  S.OPT  IONERR 

I  'm 

Suriy  but  your  selected  option 

RI 

009700 

is  not  currently  available." 

RT 

009800 

ASSIGN  &OPT  IONERR?  = 

“Please  select  another  topic." 

RT 

009900 

GOTO  GETUSER I  NPT 

BP 

010000 

* 

BP 

010100 

RIJNIIMW;  RUN  CRESPCMW  IN  &RUNL  IB  ON  &RUNVOL 

JM 

010200 

IF  RUNCMW  EQ  0  GOTO 

GETUSER  Iff  I 

010300 

GOTO  USEREXIT 

BP 

010400 

* 

BP 

010500 

RUNSWl:  RUN  LHESMSWL  IN  S,RIJNL1B  ON  &RUNVOL 

RT 

010600 

IF  RUNSWL  EQ  0  GOTO 

GETUSERINPT 

RT 

0)07  00 

GOTO  USEREXIT 

BP 

010800 
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Input  F  i  le 

is  GRES  in  Library 

CRLSOPRC  on  Volume 

CRESOO 

* 

BP 

RUNWSL : 

RUN  CRESPWSL  IN  &RUNL1B 

ON  &RUNVOL 

RT 

IF  RUNWSL  EQ  0 

GOTO  GETUSERINPT 

R1 

GOTO  USEREXIT 

BP 

it 

BP 

RUNERW: 

RUN  CRESOERW  IN  iSUNLIB 

ON  &SUNV01. 

RT 

IF  RUNERW  EQ  0 

GOTO  GETUSERINPT 

RT 

GOTO  USEREXIT 

RT 

* 

RT 

RUNATF  : 

RUN  ANALYSIS  IN  S.SUNL IB 

ON  8.SUNV0L 

RT 

IF  RUNATF  EQ  0 

GO'O  GETUSERINPT 

RT 

GOTO  USEREXIT 

BP 

* 

RT 

RUNCTP : 

RUN  CRESTAPE  IN  &SUNLIB 

ON  &SUNV0L 

RT 

IF  RUNCTP  EQ  0 

GOTO  GETUSERINPT 

RT 

GOTO  USEREXIT 

RT 

* 

RT 

RUN8CG: 

RUN  CRESOBCG  IN  &RUNLI6 

ON  &RUNV0L 

RT 

IF  RUNBCG  EQ  0 

GOTO  GETUSERINPT 

RT 

GOTO  USEREXIT 

BP 

it 

RT 

RUNMIG: 

RUN  CRESTAPE  IN  &SUNLIB 

ON  &SUNVOL 

RT 

IF  RUtMT G  EQ  0 

GOTO  GETUSER  1NP  I 

RT 

GOTO  USEREXIT 

* 

RT 

USER E X  IT : 

RETURN 

BP 

* 

RT 

USERLOG:  SET  INLIB=&SINLIR, 

I NVOL  =&SI NVOL , 

OUT 1.  1  SOI L  I B , 

K1 

OUTVOL=&SOTVOL, 

RUNE  IB=&SRNL  IB, 

RUNV0L=8>SRNV0L , 

RT 

WORKVOL=&WRKVOL , 

SPOOL VOL-&SPOVOL , 

SPOOL  I B  =& SPOL  IB 

JM 

* 

JM 

USERLOGOFF 

:  RUN  CRESORNO  IN  &SUNL IB  ON  &SUNVOL 

RT 

IE  USERLOGOFF  EQ  I  GOTO  RUNENA 
IF  USERLOGOFF  Eq  2  G0r0  RUNENB 
IF  USERLOGOFF  EQ  3  GOTO  RUNENC 
iF  USERLOGOFF  EQ  4  GOTO  RUNEND 
IF  USERLOGOFF  EQ  5  GOTO  RU(£  NE 
IF  USERLOGOFF  EQ  6  GOTO  RUNE NF 
IF  USERLOGOFF  EQ  7  GOTO  RUNENG 


GOTO  USEREND 

RT 

* 

RT 

RUNENA: 

RUN  CRSEN1  IN 
GOTO  USEREND 

&SUNLI6 

ON  &SUNVOL 

RT 

* 

RT 

RUNFNB: 

RUN  CRSEN2  IN 
GOTO  USEREND 

&SUNLIB 

ON  8.SUNV0L 

RT 

A 

RT 

RUNENC: 

RUN  CRSEN3  IN 
GOTO  USEREND 

NSUNLIB 

ON  &SUNVOL 

RT 

* 

RT 

RUNENO: 

RUN  CRSEN4  IN 

&SUNLIB 

ON  &  SUN  VOL 

RT 

A 

GOTO  USEREND 

RUNENE: 

RUN  CRSEN5  IN  &SUNL  IB 

ON  8,  SUN  VOL 

RT 

GOTO  USERENO 

RT 

RT 


3 


010900 
011000 
on  ioo 
01 1200 
01  1300 
011400 
011500 
011600 
011700 
01  1800 
01 1900 
012000 
012100 
012200 
012300 
012400 
012500 
012600 
012700 
012800 
012900 
0  1 3000 
013100 
013200 
013300 
013400 
013500 
013600 
013700 
013800 
013900 
014000 
014100 
014200 
014300 
014400 
014500 
014600 
0147  00 
014800 
014900 
015000 
015100 
015200 
015300 
015400 
015500 
015600 
015700 
015800 
015900 
016000 
016100 
016200 
016300 
016400 
016500 


RUNE  NF : 


RUN  CRSEN6  IN  &SUNLI8  ON  &SUNVOL 
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016600 

* 

RT 

0167  00 

RUNENG:  RUN  CRSEN7  IN&SUNLIB  ON  &  SUN  VOL 

GOTO  USEREND 

* 

USEREND: 

RT 

016800 
0 1 6900 
017000 
017100 

* 

* 

RETURN  CODE  =  16 

RT 

017200 

017300 

017400 
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COMMON  WORD  LIST  SUBSYSTEM 

Create/Maintain  Common  Word  List  Menu  (CRES3CMW) 

CRES@CMW  in  library  CRES@PRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  Create/Maintain  Common  Word  List  Subsystem.  It 
enables  the  user  to  select  by  PF  key  among  options  to  create/maintain  the 
Common  Word  List,  to  print  the  Common  Word  List,  to  print  the  Common  Word  List 
by  attribute,  or  to  return  to  the  CRES  Master  Menu. 

A  complete  listing  follows. 


27 


CRES@CMW  in  library  CRES@PRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  Create/Maintain  Common  Word  List  Subsystem.  It 
enables  the  user  to  select  by  PF  key  among  options  to  create/maintain  the 
Common  Word  List,  to  print  the  Common  Word  List,  to  print  the  Common  Word  List 
by  attribute,  or  to  return  to  the  CRES  Master  Menu. 


A  complete  listing  follows. 
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Input  file  is  CRESgCMW  in  Liorary  CRES@PRC  on  Volume  CRESOi 


*  RT 

PROCEDURE  CRES  COMMON  WORD  LIST  MENU  RT 

*  AUTHOR  ROSE  TANK  RT 

*  DATE  10/06/83  RT 

*  RT 

*  Aostract:  This  procedure  is  a  subsystem  of  CRES  Master  Menu  RT 

*  (option  1  -  Create/Maintain  Common  Word  List).  RT 

*  It  allows  the  user  to  select  and  run  any  Common  RT 

*  word  list  file  option.  RT 

*  RT 

DECLARE  &USERINPT  AS  INTEGER  INITIAL  0  RT 

DECLARE  &OPTIONERR  AS  STRING  (79)  INITIAL  "  "  RT 

DECLARE  &OPTIONERR2  AS  STRING  (79)  INITIAL  "  "  RT 

DECLARE  &USERNAME  AS  STRING  (24)  INITIAL  "  *  RT 

DECLARE  &ERRMSG  AS  STRING  (34)  INITIAL  *  *  RT 

DECLARE  &RUNLIB  AS  STRING  (8)  INITIAL  "  "  JM 

DECLARE  &RJNVOL  AS  STRING  (6)  INITIAL  "  *  JM 

*  RT 

EXTRACT  &USERNAME=*USERNAME,  &RUNVOLr*RUNVOL,  &RUNLI3=»OUTLia  JM 

*  <  RT 

GETTJSERINPT:  PROMPT  PEKET  =  &U3ERINPT  CENTER  RT 

DIM  ‘CRES:  Common  Word  List  Subsystem  (Common  Word  RT 

List  Menu  Screen)";  RT 


000100 

000200 

000300 

000400 

000500 

000600 

000700 

000800 

000900 

00L000 

001100 

001200 

001300 

001400 

001500 

001600 

001700 

001800 

001900 

002000 

002100 

002200 

002300 


DIM  *  = 

=============================3 

RT 

002400 

=1433  =  : 

3=33333 

333333* • 

RT 

002500 

DIM  * 

m  %  «  «  . 

RT 

002600 

DIM  ' 

The  Comriun  Word  Lists  will  be 

used  to  perform  the  CRES  ana 

RT 

002700 

lysis 

m  t 

•  I 

002710 

DIM  ' 

Use  the  appropriate" , BRIGHT  " 

PF  Key*,*  to  select  the  desi 

RT 

002800 

red  operation. " ; 

RT 

002900 

DIM  * 

•  .  *  ■  , 

RT 

003000 

DIM  " 

" , LINE  "PF“,DIM 

m  m 

! 

RT 

003100 

LINE 

II 

Operation 

RT 

003200 

•  . 

003210 

DIM  " 

RT 

003300 

DIM  ' 

",  BRIGHT  “1"," 

-  Create/Maintain  Coimnon  Word 

RT 

003400 

List 

*  . 

RT 

003500 

DIM  " 

", Bright  "2"," 

-  Print  Common  Word  List"; 

RT 

003700 

DIM  " 

"  ,Bright  "3"," 

-  Print  Common  Words  by  Attn 

RT 

003705 

bute" 

; 

003805 

DIM  * 

•  # 

t 

RT 

004100 

DIM  " 

" (Brignt  "16"," 

-  Return  to  CRES  Master  Menu1 

RT 

004200 

t 

DIM  ’ 

■  ,  *  ", 

i  t  i 

RT 

004300 

3RIGOT 

1  &OPTIONERR; 

RT 

004400 

SLINK 

&OPTIONERR2; 

RT 

004500 

ft 

RT 

004600 

ASSIGN  &ERRMSG  =  "  " 

RT 

004700 

ASSIGN  &OPTIONERR  =  *  ’ 

RT 

004800 

ASSIGN  &OPTIONERR2  =  ’  * 

RT 

004900 

ft 

RT 

0050U0 

IP 

S.USERINPT  Ey  16 

GOTO  USEREX1T 

RT 

005100 

IP 

&USERINPT  EQ  32 

GOTO  USEREXIT 

RT 

005200 

IP 

iUSERINPT  EO  1 

GOTO  RUNCWL 

RT 

005300 

IF 

MJSERINPT  EO  2 

GOIO  RUNPWL 

RT 

005500 

r? 

6USERINPT  E'J  3 

GOTO  RUNPWA 

RT 

005505 

ip 

S.USERINPT  EG  17 

GOTO  RUNCWL 

RT 

005910 

ip 

MJSERINPT  EU  18 

GOIO  RUNPWL 

RT 

005930 

Z9 
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IF  S.USERINPT  EQ  19 

GOTO  RUNPWA 

RT 

005935 

005965 

ASSIGN  &OPTIONERR  = 

“I'm  sorry,  but  your  selected  option 

Rf 

006000 

is  not 

currently  available." 

RT 

006100 

ASSIGN  &OPTIONERR2  =»  "Please  select  another  topic." 

RT 

006200 

GOTO  GETUSERINPT 

RT 

006300 

* 

RT 

006400 

RUNCWL: 

RUN  CRES@CWL  IN  &RUNLI8 

ON  &RUNVOL 

RT 

006500 

IF  RUNCWL  EQ  0 

GOTO  GETUSERINPT 

RT 

006600 

GOTO  USEREXIT 

RT 

006700 

* 

RT 

006800 

RUNPWL: 

RUN  CR£S@CWP  IN  iRUNLIO 

ON  &RUNVOL 

RT 

007300 

IF  RUNPWL  EQ  0 

GOTO  GETUSERINPT 

RT 

007400 

GOTO  USEREXIT 

RT 

007500 

* 

RT 

007600 

RUNPWA: 

RUN  CRSS@CPA  IN  &RUNLIB 

ON  &RUNVDL 

RT 

008500 

IF  RUNPWA  EQ  0 

GOTO  GETUSERINPT 

RT 

008600 

GOTO  USEREXIT 

RT 

008700 

k 

RT 

008800 

USEREXIT 

•:  RBDJRU 

RT 

008900 

30 
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Create/Maintain  Common  Word  List  (CRESSCWL) 

CRES@CWL  in  library  CRESOSRC  is  the  BASIC  language  program  to 
create/maintain  the  Common  Word  List.  The  object  language  version  is  CRESKWL 
in  library  CRES@SAV. 

This  program  first  allows  the  user  to  specify  the  word  list  to  be  created 
or  maintained.  Then  the  program  enables  the  user  to  add,  delete,  or  modify 
any  given  word.  The  program  also  provides  for  a  protection  override.  The 
protection  override  option  allows  the  user  to  clear  the  protect  bytes,  if  for 
some  reason  these  bytes  have  been  left  set  incorrectly. 

The  protection  capability  was  included  to  accommodate  multiple  users  on 
the  system.  When  a  word  on  any  of  the  CRES  word  lists  is  being  modified  by 
one  user,  the  protection  bytes  for  the  word  are  set  to  that  user's  ID.  No 
other  user  can  access  that  word  while  the  protection  bytes  are  set.  If  an 
attempt  is  made  by  one  user  to  access  a  word  protected  by  another  user,  a 
message  specifying  the  user  and  workstation  protecting  the  word  is  displayed. 
When  the  word  is  released,  the  protection  bytes  are  automatically  cleared.  To 
provide  for  the  possibility  of  the  system  going  down,  a  power  failure,  or  an 
irregular  exit  leaving  a  word  with  its  protection  bytes  still  set,  the  program 
contains  a  protection  override  capability.  For  a  given  user  to  override  the 
protection,  either  the  word  had  to  be  protected  under  that  user's  ID,  or  the 
user  protecting  the  word  has  to  be  no  longer  logged  on  to  the  computer. 

The  only  characters  accepted  in  the  input  word  are  the  letters  A  through 
Z,  and  There  can  be  no  embedded  blanks.  The  data  record  for 

each  word  also  contains  information  about  the  word's  attributes:  the  part  of 
speech  (see  table  1),  the  past  participle  flaa,  the  negative  flag,  the  form  of 
the  verb  "to  be"  flag,  and  the  root  word  flag  .  The  complete  data  record 
description  is  provided  in  appendix  A. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart. 


1 A  root  word  is  defined,  for  the  purposes  of  this  program,  as  the  form  of  a 
word  which  cannot  be  reduced  any  further;  i.e.,  the  singular,  present  tense 
word  for  nouns,  verbs  and  adjectives.  Most  other  parts  of  speech  have  only 
one  form,  which  is  considered  the  root  word. 


Technical  Report  86-001 


Table  1 

Parts  of  Speech 


PART  OF  SPEECH 


DEFINITION 


(J)  Adjective  . Modifies  a  noun  or  pronoun  (e.g.  pretty,  little) 

(j)  Adjective/verb . A  word  that  may  function  as  an  adjective  or  verb 

(e.g.  aged,  dry,  lean,  open) 

(A)  Adverb . Modifies  a  verb,  adjective,  or  adverb  (e.g. 

quickly,  highly,  very) 

(а)  Adverb/verb . A  word  that  may  function  as  an  adverb  or  verb 

(e.  g.  close,  near,  slow) 

(б)  Article . A  limiting  adjective  before  a  noun  (e.g.  a,  tne) 

(C)  Conjunction . Links  phrases  or  clauses  (e.g.  or) 

(II  Interjection . Used  for  simple  exclamations  (e.g.  Oh'.) 

(N)  Noun . Indicates  a  person,  place,  or  thing  (e.g.  woman, 

city,  box) 

(d)  Noun/adjective . A  word  that  may  function  as  a  noun  or  adjective 

(e.g.  metric,  primitive) 

(n)  Noun/verb . Word  that  may  fuction  as  a  noun  or  verb  (e.g. 

abuse,  dash,  spot,  wind) 

(P)  Preposition . Expresses  a  relationship  between  two  elements  of 

a  sentence  (e.g.  in,  on,  by,  to) 

(O)  Pronoun . Word  that  may  be  used  as  a  substitute  for  a  noun 

(e.g.  I,  you,  she,  what) 

(V)  Verb . Denotes  an  action  or  occurrence  (e.g.  run,  yawn, 
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input  File  is  G3ESfc)CWi.  in  LiDrary  CRES«)SRC  on  Volume  CRES02 

000010  /*  This  is  ti»e  CRES  COMMON  WORD  LIST  MAINTENANCE  PROGRAM  */ 


000010  /*  This  is  Life  CRES  COMMON  WORD  LIST  MAINTENANCE  PROGRAM  */ 
000060  /*  */ 
000110  /*  AJMJrtS:  Rose  Tanx  and  John  Meats  */ 
000160  /*  Date:  Oetooer  IV,  1983  */ 
000210  /*  */ 
000260  /*  */ 
000310  /*  Dus  program  was  developed  to  maintain  the  corrmon  word  list.*/ 
000360  /*  It  is  desiqned  to  insert,  delete,  and  nudity  any  word  in  a  */ 
000410  /*  common  word  list  (in  ttie  old  GtES  system,  it  was  referred  to*/ 
000460  /*  as  the  Master  Word  List).  Tnis  suosystem  has  also  Deen  ex-  */ 
000510  /*  panded  to  handle  inultiusers  Dy  use  of  protection  Dytes  set  */ 
000560  /*  in  the  record  containing  the  word  to  De  modified.  Tnere  is  */ 
000610  /*  an  override  capaoility  within  t)»  program  itself  that  */ 
000660  /*  operates  on  the  condition  that  the  user's  id,  which  is  ex-  */ 
000710  /*  tracted  from  the  system,  matches  the  protection  Dytes.  In  */ 
000760  /*  the  case  wiiere  thj  user  attempts  to  modify  a  word  currently  */ 


/*  Dus  program  was  developed  to  maintain  the  corrmon  word  list.*/ 
/*  It  is  designed  to  insert,  delete,  and  nudity  any  word  in  a  */ 
/*  common  word  iist  (in  ttie  old  GtES  system,  it  was  referred  to*/ 


JM 

RT000020 

RT0U0030 

Fl’000040 

RT000050 

JM 

FT 

RT 

JM 

RT 

JM 

RT 

JM 

JM 

JM 

RT 


000810  /* 

controlled  oy  another,  a  message  is  given 

identifying  th? 

*/ 

JM 

000860  /* 

user  and  his/ner  worxstation  numoer. 

*/ 

JM 

000910  /* 

*/ 

RT 

000960  /* 

Tin  record  layout  for  tne  coinnon  word  list 

is  as  follows: 

*/ 

RT 

001010  /* 

*/ 

RT 

001060  /* 

character  position 

identic ler 

variaDle  name 

*/ 

RT 

001110  /* 

1-20 

==>  word 

WORDS 

*/ 

Ri’ 

001160  /* 

21 

==>  part  of  speech 

PRIORS PCS 

*/ 

RT 

001210  /* 

22 

==>  past  participle 

PPARTFLS 

*/ 

RT 

001260  /* 

23 

-J>  negative 

NEGFLS 

*/ 

RT 

001310  /* 

24 

-=>  to  he  flag 

TOBEFLS 

*/ 

RT 

001360  /* 

25 

="=>  filler 

*/ 

RT 

001410  /* 

26 

-=>  root  word 

ROOTFLS 

*/ 

RT 

001420  /* 

21-26 

filler 

V 

JM 

001510  /* 

29-31 

-=>  protection  Dytes 

PROTECTS 

*/ 

JM 

001560  /* 

32-40 

==)  filler  cor  future 

additions 

*/ 

RT 

001610  /* 

*/ 

RT 

001660  /* 

The  words  are  stored 

in  an  indexed  file  with  the  word 

*/ 

JM 

001710  /* 

acting  as  the  Key. 

*/ 

JM 

001760  RT00U12U 

001810  AVQ00L30 

001860  DIM  WORO$20,IOOUFF$40,PRIUFSRC$l,PFARTFt4i,Nt3GFUl,MWLf,L$l  RT 

U0191U  DIM  T0l3EPL$i  ,ROOTFL$i ,  PRt>rECr$J,Fi$20,F2$10,MESING$14  JM 

001960  DIM  USERS 3 , USSRNAMES24 ,  FX LESS ,  LItl$8,  IVOLS6  KT 

002010  DIM  CODES!, ER1S50, ITLE$21,2AP$23,ER$65,X$1  JM 

002060  DIM  £$  1,  G$  1, 1.S  1,V$1,B$1,  C$1,  D$l,  PASS  WRD$11  JM 

002110  DIM  PFl$3,PF16$4,ENTER$5,HEADER$43,PF$4,OPER$12,TAB$3,aTAB$7  JM 

002160  DIM  MODS15, EXFS3U, DEFS7,  A5$10,LEG$5, A7S7,  P$(  13)3,  ITLE5S14  JM 

002165  DIM  ITLE6$10,PIL$16  JM 

002210  HEADERS  =  ’CRES  COMMON  WORD  LIST  MAINTENANCE  SUBSYSTEM’  JM 

002260  FIL$  =* Common  Word  List’  RT 

002310  PF16$=*PF16*  RT 

002360  TAB$=*TAB*  RT000340 

002410  QTA3$=  “ BACK TAD ’  RTOOOJSO 

002460  EXP$=’(Def inition  of  Entries  Screen)’  JM 

002510  IT[£$="Parts  of  Speech  Codes’  JM 

002560  ENTERS  =’ ENTER’  RT 

0026L0  vJORDEO$=*word  -  *  001230 

002660  PF$=*  PF  ’  RT 

002710  OPERS-*  Operation’  001250 

002760  0$=*  1*  :T$-"2"  :TH$="  3*  :U$=*  14"  :S$=*  16"  .JM 
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002810 

002860 

002910 

002960 

003010 

003015 

003020 

003025 

003030 

003035 

003060 

003110 

003160 

003165 

003210 

003260 

003310 

003360 

003410 

003460 

003510 

003560 

003610 

003660 

003710 

003760 

003810 

003815 

003860 

003960 

004010 

004060 

004110 

004160 

004210 

004260 

004310 

004360 

004410 

004460 

004510 

004560 

004610 

U04660 

004710 

004760 

004810 

004860 

004910 

004960 

005010 

005260 

005310 

005360 

005410 

005460 

005510 


PFlf  ="PF 1* 

DEFf  =' CURRENT' 

A5$  = 'ATTRIBUTES' 

LEGS  =" LEGAL" 

A7$  “'ENTRIES" 

Pf(l)="(J)":P$(2)="(j)*:P$(3)=“(A)":P$(4)=*(a)“:P$(5)=*(B)" 

P$(6)="(C>':P$(7)=*(n':P$(8)='(N)':P$(9)="(n)":?$(10)="(Pr 

P$Ul)«"(0)*:Pf(12)="(V)*:P$(13)=*(d)" 

ITL£5$  =*PART  OF  SPEECH" 

ITLE6S  “"DEFINITION" 

/*  The  following  two  lines  are  used  as  formats  in  the  packing  */ 
/*  and  the  unpacking  of  record  fields  */ 

F  If =HEX  ( A0 1 4A00  U00 1A00 1AU0 1 000 1 A001A001000 1A00  3000  9 ) 
F2$=HEX(001CA0030009) 


/*  The  extract  subroutine  is  called  to  extract  the  user's  ID  */ 
/*  from  the  system.  Tins  ID  is  used  in  setting  up  tlie  protec-  */ 
/*  tion  Dyt^es  in  the  record  currently  oeing  modified.  */ 
CALL  "EXTRACT"  AD0R( " ID" ,USER$, * IL" , LIBf,  *  IV* , IVOLf ) 

/*  The  following  code  sets  up  a  screen,  wmch  asxs  for  the  */ 
/*  name  of  the  file  containing  the  comion  word  list  that  is  */ 
/*  to  be  modified.  It  also  provides  tin  opportunity  to  change  */ 
/*  tin  library  and  volume  names  which  are  set  to  the  appro-  */ 
/*  priate  defaults.  */ 


FILE$="CMNWDlST* 

ERlf " :E$=HEX( 8C ) :  G$,L$, V$=HEX( 81 ) 

FILMNU: 

ACCEPT 

AT  (01,01), 

"CUES:  Common  Word  List  Maintenance  Suosystem", 
AT  (01,57), 

"(File  Selection  Screen)", 

AT  (02,01), 


AT  (04,14), 

"Welcome  to  the", 

AT  (04,29),  F AC( HEX( 85) ) , 

HEADERS, 

AT  ( 07,0b) , 

"Please  specify  the", 

AT  (07,24),  FAC(HEX(d4) ), 

FILf, 

AT  (07,41), 

"you  want  to  modify  oc  create,  it  tin", 

AT  (08,05), 

"default  values  are  not  satisfactory.  ", 

AT  (13,30), 

"File 

AT  ( 1 3 ,  4  3 ) , F AC ( G$ ) , F I LE$  ,  CH(08), 

range  (  •:  *  ,  'tututuue > , 

AT  (14,30), 

“Liorary  =", 


RT 

RT002760 

RT002770 

RT002780 

RT002790 

RT 

RT 

RT 

JM 

JM 

RT 

JM 

RT 

JM 

RT 

RT 

RT 

JM 

JM 

JM 

JM 

RT 

RT000Q70 

RT000080 

RT000090 

R'TOOOIOO 

RT 

JM 

JM 

JM 

000500 

000510 

RT000520 

RT000530 

RT000540 

RT000550 

RT000560 

RT000570 

RT000560 

RT000590 

000600 

JM 

RT000620 

RT 

RT 

RT 

RT 

RT 

JM 

RT 


RT 

000770 

RT000780 

RT000790 

RT000800 

RT000810 

RT000820 
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005560  AT  (14,43)  ,FAC(L$),  LIBS  ,  CH(08), 

0000 10  RANGE  (  **.  *  , 

005660  AT  (15,30), 

005710  "Volume 

005700  AT  (  15,43)  ,PAC(V$),  IVDL$  ,  Cri(0b), 

0053 10  RANGE  (  "!  "  ,  ' UUMittttt' ) , 

005300  AT  (18,24),  FAC(E$),  ER1$, 

005362  AT  ( 20 , 30 ) , “ Tress* , 

005304  AT  (  20, 36) ,?AC( HEX{ 34) ) , 

005806  ENTERS, 

005363  Al'(  20,42), 

005370  *co  continue", 

005872  AT  (21, 17), “Press", 

005874  AT  (21,23),  FAC(HEX(84) ) , 

005876  Ff 16$, 

005878  AT  (21,28), 

005880  "to  return  to  tlie  Cownon  Word  List  Menu", 

005890  KEYS(HEX(001020) ) , 

006110  ON  (BIN(  16)&8IN( 32) )  GOTO  OUT,OUT 
006210  r 

006260  /*  SET  UP  THE  (JSER  PILE  BLOCK  */ 

006310 

006360  SELECT  1 1,  "COMMON*  ,VARC,  INDEXED, RECSIZE=40,Kr:YPOS=l,KSYLEN=20, 


006410  [OERR  GOTO  IOEftftl 

006460 

006510  /*  SEE  IP  THE  SPECIFIED  PIt,E  EXISTS  */ 

1)06560  /*  Y-  the  Pile  exists  and  the  program  iiuy  continue  */ 

006610  /*  N-  tlx;  file  doesn't  currently  exist,  you  may  create  one  */ 

006660  /*  V-  the  volume  supplied  doesn't  exist  or  is  not  nwunted  */ 

U067I0  /*  L-  the  liorary  supplied  doesn't  exist  m  tie  volume  given  */ 

006760  /*  E-  there  is  an  I/O  error  in  the  file  specified  */ 

006810 

UU686U  CALL  *  LIMITS"  ( PILES,  LIB$,  IVOL$,CODE$,£Rl$) 

006910  I?  COOE$="Y“  THEN  RECCK 
006960  IP  CODE$="N"  THEN  CREATE 


007010  IP  CODE$="  V"  THEN  GOSUd'  7{3TR(  ER1$,  3)  ,HEX(  81 )  ,HEX(  81 )  ,HEX(  91 ) ) 
007060  IP  COOE$="L"  THEN  Q0SU3' 7(STR( ER1$, 3)  ,HEX(  81)  ,HEX(  91 ) , HEX( 81 ) ) 
OO/UO  IP  CODE$="E"  THEN  QGSUB' 7(STR(ER1$,  3)  ,HEX(  81)  ,HEX(  81 )  ,HEX(  81 ) ) 
007160  GOTO  PILMNU 
007210 

00/260  /*  Ttie  following  screen  allows  tlw  user  to  create  an  addition-  */ 
007310  /•  al  Common  Word  List,  if  the  user  so  desires,  OR  return  to  */ 
007360  /‘the  previous  screen  to  respecity  necessary  file  information. */ 
007410 

00/460  CREATE: 

007510  ERl$  -  *  " 

007560  ACCEPT 

OO/blO  "CRES:  Common  Word  List  Maintenance  Subsystem", 

00/660  AT  (01,53), 

007710  "(Create  File  Option  Screen)*, 

007760  AT  (02,01), 

007860  =  =.*-=-==• , 

00/4!,)  AT  (0b, 03), 

00/960  "Ti»:  tile  you  luve  selected  does  not  currently  exist  in  tr>r  libra 

008010  ry", 

003060  AT  (07,08), 


:  RT000830 
I  RT000849 
:  RT000850 
:  RT000860 
:  RT000870 
:  RT000880 
:  rt 
:  rt 

!  RT 

:  rt 
;  rt 
:  rt 
:  rt 
:  rt 
:  rt 

!  RT 
:  rt 
:  jm 

RT 

RT000960 
000970 
RT000980 
!  RT000990 
RT001000 
RT001010 
RT 
JM 
RT 
RT 
RT 
RT 

RT001030 

RT 

RT 

RT 

RT 

RT 

RT 

001100 

RT001110 

JM 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

Ri' 

RT 

RT 


35 


Technical  Report  86-001 


Wang  VS  Integrated  editor  -  Version  6.10.UU  11:35  11/09/84  Page 

Input  File  is  CRESgCWL  in  Library  CRESgSHC  on  Volume  CRES02 


008110 
008160 
008210 
008260 
003310 
008360 
008410 
008460 
008610 
008660 
008610 
008660 
003710 
008760 
0083 10 
003360 
.1289.0 
003160 
Oil  40  10 
OjOUOU 
I.i  -ti  10 
M  l  i(j0 

}■■  *.  iu 

i'M-t.’jO 
00  *  i  i  0 
000 JOO 

1044  1  ■  i 
Oil  MoU 

JjdO.O 
00 3 560 
004.,  10 
000660 
000/10 
000 760 
004310 
OOOdoO 
110160 
0lil.Mil 
1)10260 
010310 
010  160 
010410 
010460 
0106)0 
0 10660 
010610 
010660 
010710 
010760 
U10810 
010360 
010910 
010960 
010961 
010965 
011060 
011110 


“and  volume  specified.  For  your  convenience,  the  following  are  ", 
AT  (08,08), 

‘the  parameters  you  submitted. “, 


AT 

(11, 

30) 

9 

File 

t 

AT 

(11, 

40) 

,  FAC ( HEX ( 85 ) ) ,  F 

ILLS 

,  CH(08), 

AT 

(12, 

30) 

LiDrary=* 

9 

AT 

(12, 

40) 

,  FAC(  tlEX(  85) ) , 

Lias 

,  Cri( 08) , 

AT 

(13, 

30) 

Volume  =" 

9 

AT 

(13, 

40) 

,  r'AC(  rlEX(  85)  ) , 

ivulS 

,  CH( 06 ) , 

AT 

(17, 

15) 

To  create 

1  a  new 

1 1  le  t  com  these 

parameters. 

press*, 

AT 

(17, 

6S) 

,  FAC  ( tiEX  (80)), 

El  1’ErtS 

,  CH( 05) , 

AT 

(  19, 

2  b ) 

To  select 

anut.  r>_* 

:  lile,  press’. 

AT 

(19, 

‘->6) 

,  FAC(  HEX( 35) ) , 

PF1S 

,  CH(  03) , 

8 E  78 1  3  I N i  0 ) &3 IS (  1  t  fcid  IN \  1  ; )  ) ,  KEY  v OP! I  a)  ) , 
■Xi  J1NI 1  )  fcJINU  7)  )  -JdTJ  BLANKF.dlJvNKr' 


*  Create  tne  new  tile  and  insert  a  Header  record  to  identify  it*/ 

iJl’iiN  DJCF.VAPM  *1,  .XilVJ.',  r'It.rl$,  [.fOHA3Y=I,trt$,  ! 

VnidMr>  VJO'.S,  NPACE=  iO JO 
TWO. ‘  C.  ftUll  WURDJ* 

WRii’E  |i,  l,)dJr'"'$ 

C  *  JSC  }1 
JDIU  22  1 

dLANKF:  r'  I  LE$  -  *  VUKVJ  FI.’MNU 

*  Chr-CK  ttv  record  size  netore  opening  the  rile  to  avoid  */ 

/*  accidently  resetting  it.  */ 

RECCK:  CALL  ‘READFDR’  AJDR(  r  l.avS.LidS,  1VULS,0«,  *HS‘  ,RS12t,RhTt) 

IF  KS 1 240  40  THEN  WRG8I2E 

22  1:  OPEN  NOGETPARM  |l,SilA3iv),  FILE*  FILES,  LIBRARY  =  UO$,  ! 

WLUME  *  IVOLS 

pea;)  ii,  :orjff$ 

IF  IOl3UFF$="  COMMON  WUIDL*  1’HEN  YEJ 
CLOSE  #1 

WR.INI/.E:  F.$=iIEX(  94) 

ER1S*  "File  type  is  wrong  -  please  respecify. " 

GOIO  FILMNU 

YES: 


/*  l'lus  section  uL  code  generates  anoL her  screen,  wincli  asKs  */ 
/*  for  tin:*  particular  word  ai>3  its  corresponding  iteration  -  */ 
/*  either  insert  word,  delete  woca,  or  modify  word.  Tne  user  is  */ 
/*  also  at  this  point  given  tne  option  of  returning  to  the  */ 
/*  Common  Wrrd  last  Menu.  */ 


Ert$,EHl$,  WORDS  =*  * 

2AP$="Please  select  tlie  word:" 
ES=riEA( 84 ) 

X$=riEX{ 81 ) 

PA.'3SWftD$=ilEX(  0001020  oOEUH  1 12131E2U) 
CWMENU: 

ACCEPT 


4 


JM 

RT 

RT 

RT 

KT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

JM 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

001150 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

JM 

JM 

RT001190 

JM 

JM 

RT001220 

RT 

RT 

JM 

JM 

001340 

001360 
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lli  i  lt>0 

AT 

(01, U 1 ) , 

"CHES:  Comiun  Nurd 

mat  Maintenance  Subsystem", 

HT001370 

0 1 1 2  1 0 

Al' 

101,43) , 

"(Word  i.  Option  Selection  Screen)", 

RT0U138O 

01  I  2b0 

>  UZ,Ui J  , 

011310 

-  -  -  ^  - 

=  =--2= - 

_ _ _  _ _ M 

RT001400 

011300 

AT 

(04,08) 

,  PAC  ( HEX  (80), 

HT 

01  I4n) 

TAPS , 

001420 

011460 

AT 

(06,28) 

,  r AC(  HcIX  (8C))/ 

HT 

011  510 

.JOHDE 

0$  , 

001440 

GllooJ 

A  2 

( Ub, 36) 

,  r  AC  (  X$ ) ,  WUi<D$ 

,  CH( 20)  , 

JM 

011610 

AT 

(03, 16) 

,  t^A  C  (  £$ ) ,  fHS , 

nr 

J 1 L6o0 

AT 

(09,28) 

,  r AC ( E$ ) ,  EH1$, 

HT 

011710 

AT 

( 11,08) 

" To  cont 

HT 

011760 

inu«*, 

select  t  ne 

PP  key  correspondinq 

to  the  desired  operation.', 

HT 

01  Idl'd 

AT 

(13,30) 

,  t’AC(HEX(AOJ  ) , 

HT001490 

UildbU 

t‘r'S  / 

RT 

01  1410 

AT 

( 1  3, 38) 

,  FAC(  ilEX(  AC) ) , 

OOibiO 

011460 

OPERS 

t 

001520 

01 20 10 

AT 

(15,31) 

,  r’AC(  riKX(  84 ) ) , 

001530 

0 1 2060 

i  >$  , 

001540 

did.  Id 

AT 

015,  3'J) 

001550 

.)  1  21  DO 

*  ; : j  j 

Hi'  word", 

001560 

J 122  10 

a  r 

.  16,  W 

,  PA.  a  riEX(  8  t) ) , 

001570 

)  i .  .*•'«. ) 

:$  , 

001580 

) 

a  r 

\  L Of  if) 

001540 

i  i  O' ) 

"  j 

i  ri  w 

j.,  j"  f 

00 1600 

j 

a  ; 

; :  \  v . 

,  f’Av.  (  Hi’.X  {  84))/ 

001610 

Ii  ;  -in' 

70$, 

00io20 

j; :  • 

A 1 

i  i  ’ ,  3 .)  i 

001630 

J.  .  ;r  .  1 

m>\ 

~  i  w 

■  r*  »" 

1  •  '  *  f 

001640 

? 

a  r 

i  2.,,  i.  : 

,  HACl 0EX( 84 )  ) , 

JM 

_  r  r-. 

_<t. 

JM 

;  *  i 

AT 

v  .  J,  id 

JM 

•  .Or 

>;\  >v-?ri 

idle"’  / 

HT 

../  .  VI. 

A 

i  _  i , 

,  rVWi  H/vXi  d4)  J , 

RT 

. .  t.H. 

;S 

001700 

j  L  :>* 

A * 

i  ..  I,  y*  i 

K  f 

I  1  i  i  n  . 

-r;..r 

r:i  - 

»  ‘.viTVjr 

Word  Jisr  Mena", 

001/20 

i .  • . 

ijA. * 

•;.al  1  , 

.JM 

■  *  .*•  ;  *. 

r  :  i 

K'i  J 

.  I/l 

; i  U".- 

'  .  n  .'it 

r'rr.xi-  m  riiri;<  xxir 

j; j4oj 

.  , 

W_JtO$) 

0,  Vi  1 0 

'  .4 

•  . 

'  ,\A 

hi. :.<;«*)  pjh-s  a)  ywx  y  /,  - 

"=3TH(V*JR2)$,  1,1)  )=i) 

JM 

1. 

THEN  ICUiU 

).  (bid 

.«:\A . 

1 

1 1  d  e  * '  a 

:i;  Ki  t  ;•.$  •  I ■:.<i  n.)  .  RT 

ii )  ;o.i  :y$,r^i$  »•  *  Ki' 

UlJoiJ  /*  Chuck  tor  confirmation  ot  delotion  */  HI' 

0 1  3360  Ir'  (OPT  I  'N  J  )  ANi)  (UP  1  )  THEN  DEi.  HP 

01)41.1  /*  Check  tor  cancellation  ot  deletion  V  JM 

.)  1  WoJ  If  .Jr-i  l.i.li  JPJATii  HP 

0 1 4  j  1 J  *  Ci»*ck  for  override  of  r.  tv  protection  o/t-  */  HT 

0 1 40  60  If  i  iHl'I-Kl  14)  If  i  tip  P IOU  =  JO )  THEN  OVE.RR  I  Do  JM 

mil  i a  :?  p,:*r .  words,  i ,  i  x>  *  *  then  reed  hi 

J14180  001330 

01421 J  a-:.  .  H  A10 ld40 
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014260 

014310 

014360 

014410 

014460 

014510 

014560 

014610 

014660 

014710 

014760 

014810 

014860 

014910 

014960 

015010 

015060 

015110 

015160 

015210 

015260 

015310 

015360 

015410 

015460 

015510 

015560 

015610 

015660 

015710 

015760 

015810 

015860 

015910 

015960 

016010 

016060 

016110 

016160 

016210 

016260 

016310 

016360 

016410 

016460 

016810 

016560 

016610 

016660 

016710 

016760 

016765 

016770 

016810 

016860 

016910 

016960 


ER$  =  "  The  first  character  cannot  oe  clank.* 

ER1S=  "Please  reenter  the  appropriate  word  and  PP  Key.’ 

E$=  HEX( 94 ) 

GOTO  CWMENJ 

ILLERR: 

ERi>=" Illegal  character  found  in  word  -  please  reenter.* 

E$-  HBX(  94) :  GOTO  CWMENU 

OVERRIDE: 

IF  NF=1  AND  Pt=l  THEN  CHK 

£R$="Please  check  first  if  the  protection  is  set  uy  selecting  PF3* 
E$=HEX( 84) 

GOTO  CWMENU 

/*  Protection  override  is  confirnved  if  the  protection  oytes*/ 

/*  indicate  a  user  not  currently  logged  on  or  if  the  */ 

/*  current  user's  id  equals  the  protection  Dytes.  */ 

CHK: 

If  (USER$=PROTECT$)  OR  (WRKST%=-1)  THEN  REMOVE 

ER$-  "You  don't  lave  the  clearance  to  override  the  protect." 

E$=  HEX(84) 

GOTO  CWMENU 

/*  Reset  the  protection  oytes  to  Dlanks  */ 

REMOVE:  PROTECTS”  *  “  :P*=0 

READ  #1,  HOLD,  KEY=V»RD$,  iOBUFFS 

$PACK  ( F=F1$)  IOdUFFf  FROM  ,*JRD$,  PRTOFSPCS,  PPARl'FLS,  1 
NEGrL$,  iOBEFES ,  ROOTf L$ ,  MWLf  i$ ,  PROTECTS 
REWR I TE  *1,  IOBUFF$,  DATA  GOIO  IOERR2 
ER$=  "  You  may  now  select  your  option.’ 

£$=  HEX( 84 ) 

GOIO  CWMENU 


IOERRl : 


10ERR2 : 


PRINT 
E$=MEX( 94) 

EKl$=  "File  type  is  wrong  -  please  respecify.’ 
CLOSE  #1 
GOTO  FILMNU 

PRINT 

PRINT  HEX( 94) , "Error  scarred  on  rile  FILE $ 

PRINT  tlEXl  94) ,  "Error  code  =  *;  FS(ll) 

STOP  "Touch  rU) j’eh  to  return  to  menu." 

GOTO  CWMENJ 


/*  If  "ENTER"  win  hit  accidently  nefore  an  option  was  given  */ 

REED:  IF  OPTIONOl)  THEN  JRCH 

ER$=*  "  Coimund  missing." 

E$=  HEX( 94) 

GOTO  CWMENU 

SRCH:  P*=) 

READ  « 1, HOLD, KEY=WORJS, IODOFrS, BOD  GOTO  NOT FOUND, 

DATA  0710  IOERR2 


RT001850 
r  r 

RT 

001880 


RT 

RT 

RT 

RT 

RT 

RT 

JM 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

001890 

RT 

RT 

001910 

001930 
RT001940 
RT001950 
RT001960 
RT001970 
R  TOO  1980 
RT001990 
RT002000 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 

RT002020 

RT00203U 

RT002040 
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017010 

RT002660 

017060 

/*  Unpack  and  check  if  currently  oeing  modified  oy  another  * / 

RT002670 

017110 

RT002680 

017160 

SUNPACK  ( F=Fl$)  IOBUFFS  TO  WORDS, PRTOFSPCS,  PPARTFLS,  '. 

RT002690 

017210 

NEGFLS ,  TOBEFLS ,  ROOTFLS ,  MWLFLS ,  PROTECTS 

RT 

017260 

IF  PROTECT$=  *  *  THEN  MOW 

RT 

017310 

CALL  "FINDUSER"  ADDR  (  PROTECTS ,  USERNAMES ,  WRKST% ) 

RT 

017360 

E$=  HEX( 94) 

RT 

017410 

CONVERT  WRKSINs  TO  WRKSTS, PIC( III) 

RT 

017460 

ERS=*  Sorry,  "i  USERNAMESs"  is  currently  editing  " 

RT 

017510 

ERl$=  WORDS  &  a  "  at  workstation  *6.  WRKSTS 

RT 

017560 

REWRITE  fl,IOaUFP$ 

RT 

017610 

GOTO  OWMENU 

RT 

017660 

RT 

017710 

now:  protect$=  users 

RT 

017760 

SPACK  (F=F1$)  IOBUFFS  FROM  WORDS,  PRTOFSPCS,  PPARTFLS, 

RT 

017810 

NEGFLS ,  TOBEFLS ,  ROOTFLS ,  MWLFLS ,  PROTECTS 

RT 

017860 

REWRITE  #1,  IOBUFFS,  DATA  GOTO  IOERR2 

RT 

017910 

RT 

017960 

/*  NOW  BRANCH  TO  THE  OPTION  SELECTED  */ 

RT002050 

018010 

OPT:  ON  OPTION  GOTO  INSERT, DELET/MODIFy 

RT 

018060 

ON  OPTION-lb  GOTO  INSERT, DELET,MODIFi 

RT 

018160 

002160 

018210 

NOTFOOND:  NF=0 

RT002170 

018260 

GOTO  OPT 

RT002180 

018310 

RT002190 

018360 

INSERT: 

RT002200 

018410 

/*  NF-0  indicates  the  word  doesn't  yet  exist  so  go  ahead  V 

RT002210 

018460 

/*  and  insert.  NF=1  indicates  the  word  exists.  */ 

RT002220 

018510 

RT002230 

018560 

IF  NF=i  THEN  EXIST 

RT002240 

018610 

MODS=  "(Insert  Screen)" 

RT002250 

018615 

MESINGS=" inserting  word" 

JM 

018660 

ROOTF  L$ ,  PPARTFU ,  PRTOFS  PCS ,  NEGFLS ,  MWLFL$=  "  " 

RT 

018710 

PROTECTS3  USERS 

RT 

018760 

SPACK  (F=F1$)  IOBUFFS  FROM  WORDS,  PRTOFSPCS,  PPARTFLS,  ! 

RT 

018810 

NEGFLS ,  TOBEFLS ,  ROOTFLS ,  MWLFLS ,  PROTECTS 

RT 

018860 

WRITE  il,  IOBUFFS,  DATA  GOTO  IOERR2 

RT 

018910 

GOTO  [NS  /*  goto  the  screen  with  the  word  attnrtxites  */ 

RT 

018960 

002320 

019010 

/* 

Coming  from  insert  with  the  word  currently  existing,  */ 

RT 

019060 

/* 

print  an  error  message  and  erase  the  protection  from  */ 

RT 

019110 

/* 

the  record.  */ 

RT 

019160 

EXIST: 

002360 

119210 

ER$  =  ’Th’  word  '*  a  iURiiS  t>  "'  already  exists  in  this  list." 

RT002370 

01  9261) 

ES-  HEX( 94) 

RT 

READ  #1,  HOLD,  KEi=  WORDS, IOBUFFS 

RT 

019360 

PROTECTS3"  "  :  P4=0 

RT 

019410 

SPACK  (F=F1$)  IOBUFFS  FROM  WORDS,  PRTOFSPCS,  PPARTFLS, 

RT 

U 19460 

NEGFLS ,  TOBEFLS , ROOTFLS , MWLFLS ,  PROTECTS 

RT 

019510 

REWRITE  #1,  IOBUFFS,  DATA  OOTO  IOERR2 

RT 

019560 

GOTO  CWMENU 

RT 

01 9b 10 

RT 

019660 

/‘ 

DELET,DEL,  &  MODEL  all  pertain  to  the  delete  option  */ 

RT 

019710 

/* 

DELST-  gives  the  user  a  clance  to  cancel  the  deletion  */ 

JM 

019760 

OF. LET:  IF  NF=0  TORN  MODEL 

RT002420 

019810 

DF»i 

RT002430 

3y 
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019860 

019910 

019960 

019965 

019970 

020010 

020060 

020110 

020160 

020210 

020260 

020310 

020360 

020410 

020420 

020425 

020460 

020510 

020560 

020610 

020660 

020710 

020760 

020810 

020860 

020910 

020960 

021010 

021060 

021110 

02II60 

021210 

021260 

021270 

021310 

021360 

021410 

021460 

021510 

021560 

021610 

021660 

021710 

021760 

021810 

021860 

021910 

021960 

022010 

022060 

022110 

022160 

022210 

022260 

022310 

022360 

022410 


ER$=  *  Press  ENTER  to  confirm  deletion  of  *&  WORDS 

ERl$=*or  press  PF14  to  cancel  tne  deletion.  * 

E$=  HEX(94) 

PASSWRD$=HEX( 000E1E) 

X$=HEX( 85) 

GOTO  CHMENU 

/*  DEL-  deletes  the  entire  record  */ 

DEL:  READ  #1,  HOLD,KEf=WORD$, IOBUPFS 

DELETE  #1 
DF=0 

ER$=  *  '■toWROSS"'  deleted  -  Please  select  your  next  word.* 
ZAP$=*  " 

NORD$="  *  :NF=0 

PASSWRD$=*HEX(000102030E101112131E20) 

X$=riEX(  81 ) 

GOTO  CHMENU 

/*  NODEL-  prints  an  error  messages  when  the  word  doesn't  exist  */ 
NOOEL:  ER$=f  ’The  word  WORDS  &  does  not  exist  in  this  list." 
E$=*  HEX(  94) 

GOTO  CHMENU 

MODIFY:  IF  NF»i  THEN  GBTIT 

ER$="The  word  you  are  attempting  to  modify  does  not  exist"&  ! 
“  in  this  list.* 

/*  if  word  not  in  list,  */ 

E$=*HEX( 94)  /*  set  up  message  and  fac  and  */ 

QOID  CHMENU  /*  go  oacx  up  to  previous  screen  */ 

GETIT: 

MODS  =*{ Modify  Screen)* 

MESING$=»“ modifying  word" 

INS: 

ER1S  ="  * 

E$  =HEX(8C) 

/*  This  accept  statement  generates  a  screen  with  the  attrioutes  */ 
/*  corresponding  to  each  word  appropriately  laoeled  for  insert  V 
/*  or  modification.  It  also  calls  another  screen  on  request  if  */ 
/*  there  is  a  need  for  a  explanation  of  legal  entries  for  the  */ 
/*  parts  of  speech.  V 

AOK : 

ACCEPT  1 

AT  (01,01),  : 

"CRES:  Comnon  Word  List  Maintenance  SuDs/stem",  I 

AT  (01,66),  FAC(HEX(  80  )  ,MOD$, 

AT  (02,01),  "===========================================! 

AT  (03,07),  '  1 

"For  an  explanation  of  legal  entries,  press",  ! 

AT  (03,50), FAC( H£X( 84 ) ) ,  PFi$,  I 

AT  (03,54),  ! 

";  otherwise,  enter",  .' 

AT  (04,07),  I 

"tin  appropriate  attnoute(s) .  *,  I 


RT 

JM 

RT 

JM 

JM 

RT0G2460 

RT002470 

RT 

RT 

RT 

RT002490 

RT 

JM 

JM 

JM 

RT002530 

002540 

RT 

RT002550 

RT 

RT002570 

RT002580 

RT002590 

RT 

RT0U1300 

RT 

RT 

RT002620 

RT002630 

RT 

RT002720 

RT002730 

JM 

RT002740 

RT 

RT 

RT002830 

RT 

RT 

JM 

RT 

RT 

RT002840 

RT002850 

RT002860 

RT002870 

RT002880 

RT002890 

RTU02900 

RT002910 

JM 

RT 

RT 

RT002950 
RT002960 
R  T002970 
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022460  AT  (  06, 33) ,FAC(  HEX(  AD) ) ,  DEF$  , 

022610  AT  (06,41) ,FAC( H£X{ AD) ) ,  A5S  , 

022660  AT  ( 06, 58) ,FAC( HEX( AD) ) ,  LEGS  , 

022610  AT  (06,64) ,FAC( HEX( AD) ) ,  A7$  , 

022660  AT  (08,07), 

022710  ’WORD:', 

022760  AT  (08, 15)  ,FAC(H£X(  84) )  ,  WORDS, 

022810  RANGE  (  "1  "  ,  '  tt-ti-Htt-ttet-' ) , 

022860  AT  (08,61), 

022910  *(A~2.-,)\ 

022960  AT  (10,07), 

023010  "PART  OF  SPEECH:", 

023060  AT  (JLD,41),FAC(HEX(80)),PRWFSPC$,  CH(0i), 

023110  AT  (10,57), 

023160  "(ASCIJNOPVadjn)*, 

023210  AT  (11,07), 

023260  "PAST  PARTICIPLE:*, 

023310  AT  (11,41),  PPARTFLS  ,  Cri(Ol), 

023360  AT  (11,57), 

023410  "  (*  or  NO  fc^TRY ) * , 

023460  AT  (12,07), 

023510  "NFX3ATIVE:  * , 

023860  AT  (12,41),  NEGFLS  ,  CH(01), 

023610  AT  (12,57), 

023660  "(*  or  NO  ENTRY)", 

0237 10  AT  (13,07), 

023760  "TO  BE:", 

023810  AT  (13,41),  TOdEFLS  ,  Cri(Ol), 

023860  AT  (13,57), 

023910  "(*  or  NO  ENTRY) ", 

023960  AT  (14,07), 

024260  "ROOT  WORD:", 

024310  AT  (14,41),  ROOTFLS,  CH(Oi), 

024360  AT  (14,57), 

024410  "(*  or  NO  ENTRY)", 

024460  AT  (17, 25), FACIES), ER1$, 

024510  AT  (  20,17), "Use" , FAC (  HEX( 85) ) ,TAB$, “or" ,FAC(  HEX ( 88) ) , 

024560  8TAB$, "to  move  Between  modiriaDle  fields.", 

U2461U  AT  (  23,30), 

024660  "Press", 

024710  AT  (23,36)  ,FAC(11EX(84)  ), ENTERS, 

024760  AT  (23,42), 

03.4810  "to  continue", 

U248bU  AT  (24,21), 

024910  “Press*  ,A1'(  24,27)  ,FAC(riSX(84) )  ,PF16$,AT(  24, 32) , 

024960  "to  exit  without  ", 

U24965  AT(24,48),FAC(HEX(8C)),  MESINGS, 

025010  KEYS( 3IN(0 ) &BIN( 1 )  &BXN( 17) &BXN( 16)6SIN( 32) ) ,KEY(OPTION) , 

025060  ON  ( 8IN(  16)  63IN(  32) )  <XTCO  EX  IOM ,  EX  ION 

025110 

025310  IF  Ot'ClUN-l  OR  OPTION=X7  THEN  DEFIN 
025360  ERl$=*  * 

025410 

025460  /*  Check  lor  validity  of  entries  */ 

025510 

025560  IF  rtjS(*ABCIJNOPVadjn"=PRTOFSPC$)>0  THEN  NEXT1 

025610  ER IS  =  "Part  of  Speech  value  is  illegal." 


RT002960 

RT002990 

RT003U00 

RT003010 

RT0Q3020 

RT003030 

RT003040 

RT003U50 

RT003060 

JM 

RTQ03080 

RT003090 

RT003100 

RT003110 

RT 

RT003130 

RT003140 

RT00J150 

RTU0JT60 

RT003170 

Rr003180 

RT003190 

RT 

RT003210 

Rr00322U 


RT 

Hi 

RT 

RT 

JM 

RT 

RT003270 

RT 

RT 

RT00JJ00 

JM 

JM 

JM 

JM 

r  r 
nr 

RT003320 

RT 

RT 

0U3380 
R TOO  3 390 
RT003400 
RT 

R TOO 34 20 
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023660 

E$  =  HEX( 94) 

RT 

025710 

GOTO  AOK 

RT003440 

025760 

RT 

025810 

NEXT1: 

IE  POS(*  **=PPARTFL$)>0  THEN  NEXT2 

RT00343U 

025860 

ER1S  =  "Past  Participle  value  is  illegal.* 

RT0U3460 

025010 

E$  =  HEX( 94) 

RT 

025960 

GOTO  AOK 

RT00348U 

026010 

NEXT2: 

IF  POSC  *"=*NEGFL$)>0  THEN  NEXT3 

RT 

026060 

ER1S  =  "  Negative  value  is  illegal.* 

RT 

026110 

E$  =  HEX( 94) 

RT 

026160 

GOTO  AOK 

RT003520 

026210 

NEXT3: 

IF  POSC  **-TOBEFL$)>0  THEN  NEXT4 

RT 

026260 

ERlS  =  *  To  Be  value  is  illegal.* 

JM 

026310 

S$  =  HEX( 94 ) 

RT 

026360 

GOTO  AOK 

RT 

026610 

NEXT4 : 

IF  POS(*  *  *  -ROOTFLfc  )>  0  THEN  UPDATE 

RT 

026660 

ER1$  =  *  Root  word  value  is  illegal." 

RT 

026710 

E$  -  HEX( 94) 

RT 

026760 

GOTO  AOK 

RT 

026810 

i 

RT 

026860 

/*  F.XIOM  IS  USED  TO  EXIT  THE  INSERT  MODE  AND  CALL  NOCHAN  */ 

RT 

026910 

/*  TO  1 

EXIT  THE  MOD  I F  Y  MODE  */ 

RT 

026960 

EX  TOM; 

HEAD  »1,  HOLD,  KEY=WORDS,  IOBUFFS 

RT 

027010 

IF  NF=1  TilEN  NOCHAN 

RT 

027060 

DELETE  #1 

RT 

027110 

ER$=  "  Word  "&WORDS&*  was  not  inserted." 

RT 

027160 

GOTO  CWMENU 

RT 

027210 

RTU0333D 

027260 

NOCHAN 

:  PROTECTS  =  "  "  : P%=0 

RT 

027310 

SPACK  (F=F2S)  IOBUFFS  FROM  PROTECTS 

RT 

027360 

REWRITE  #1, IOBUFFS, DATA  GOTO  IOSRR2 

RT 

027410 

ERS=  "  No  clanges  were  saved.’ 

RT 

027460 

ES=  HEX(  80 

RT 

027510 

GOTO  CWMENU 

RT 

027360 

' 

RT 

027610 

/*  UPDATE  removes  cb.'  protection  on  the  record  and  writes  out 

»/  RT 

027660 

/*  the 

final  data  as  input. 

V  JM 

027710 

UPDATE 

:  READ  |1,  HOLD,  KEY=V*JlUl,  IOBUFFS 

RT 

027760 

PROTECTS  =  "  "  :P%=0 

RT 

027810 

SPACK  ( F-r  IS)  IOBUFFS  FROM  WORDS,  PRTOFSPtXPPARTFLS, 

:  RT 

027860 

NHGFLS,  rOBEFL$,ROOTFL$,MWLPL$,  PROTECTS 

RT 

027910 

REWRITE  #  1 ,  IOBUFFS , DATA  GOTO  IOERR2 

RT0U360U 

027960 

ERi$=  "  " 

028010 

IF  HF-0  THEN  RITE  /*  NF=0  indicates  insert  mode 

*/  RT 

028060 

IF  DF  =  1  THEN  F.XDEL  /*  DF=i  indicates  delete  mode 

V  RT 

028110 

7.APS*"  ’  /*  otherwise  in  modify  mode 

V  RT 

028160 

ER$=* 

'"{.WORDSC  updated  -  Please  select  next  word." 

JM 

028210 

K$=HEX( 8C ) 

RT 

028260 

WORDS*"  " 

028310 

GOTO  CWMENU 

RT003610 

028360 

KITE: 

RT003620 

028410 

ER$=  * 

1 " &WOiO$&" 1  inserted  -  Please  select  your  next  word.* 

RT 

028460 

3AP$  =  *  * 

028510 

NORD$="  " 

028560 

GOTO  CWMENU 

RT003660 

028610 

0U3670 

028660 

EXDSL: 

DF=II 

RT 

ms 


Wl 


'■f  •*-'* 


\S. 


>3 


•\1 

■jj 
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038710  EK$-"  Deletion  cancelled." 

028720  PASSWRD$=HEX( 000 I02030E101 1121 31E20) 

028725  X$=HEX(81) 

028760  GOTO  CWMENU 

028810 
029110 

029160  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */ 
029210  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  V 
029260  DEF  FN '  7  ( ER 1$ ,  8$ ,  C$ ,  D$ ) 

029310  PRINT 

029360  E$=HEX( 94) 

029410  G$=B$ 

029460  U=C& 

029510  V$=D$ 

029560  RETURN 
029610 

029660  DEF IN: 

029/10  ACCEPT 

029760  AT  (01,01), 

029810  "CRES:  Coitupon  Word  List  Maintenance  Subsystem", 

029860  AT  (01,51),  FAC ( HEX (  80  ) , 

029910  EXP$, 

029960  AT  (02,01), "===============-===============■ 


030010  ^=====================-========-=", 

030055  AT  (05,08),  FAC( KEX( AD) ) ,  ITLE5$  ,  CH(14), 

030060  AT  (05,49),  FAC(HEX(AD) ) ,  TILS 6$  ,  CH(10), 

030065  AT  (07,03),  FAC( HEX( 84) ) ,  P$(l)  ,  CH(03), 

030070  AT  (07,08), 

030075  ’ Adjective  . Modifies  a  noun  or  pronoun", 

030080  AT  ( 0d,03) ,  FAC( HEX( 84) ) ,  P$(2)  ,  CH(03), 

030085  AT  (08,08), 

030090  "Adjective/ verb  . A  word  that  may  function  as  an  adjective 

030095  or  verb", 

030100  AT  (09,03),  FAC( HEX( 84) ) ,  P$(3)  ,  CH(03), 

030105  AT  (09,08), 

030110  "Adverb  . Modifies  a  verb,  adjective,  or  adverD", 

030115  AT  (10,03),  FAC(HEX(84) ) ,  P$(4)  ,  CH(03), 

030120  AT  (10,08), 

030125  "Advero/verb  . A  word  that  may  function  as  an  adverb  or 

030130  verb", 

030135  AT  (11,03),  FAC( HEX( 84) ) ,  P$(5)  ,  CH(03), 

030140  AT  (11,08), 

030145  "Article . A  limiting  adjective  before  a  noun  (e.g. 

030150  a,  the)", 

030155  AT  (12, U3),  FAC(HEX(84) ) ,  P$(6)  ,  CH(03), 

030160  AT  (12,08), 

030165  "Conjunction  . Links  phrases  or  clauses  (e.g.  or)", 

030170  AT  (13,03),  FAC( H£X( 84) ) ,  P$(7)  ,  CH ( 0 3 ) , 

030175  AT  (13,08), 

030180  "Interjection  . Used  for  siriple  exclamations  (e.g.  01)1)" 

030185  , 

030190  AT  (14,03),  FAC(HEX( 84) ) ,  P$(8>  ,  CH(03), 

030195  AT  ( 14,08), 

030200  "Noun  . Indicates  a  person,  place,  or  thing", 

030205  AT  (15,03),  FAC( HEX( 84) ) ,  P$(13)  ,  CH(03), 

030210  AT  (15,08), 

030215  "Noun/ad  ject  i  ve . A  word  tfat  may  function  as  a  noun  or  ad 


JM 


JM 

JM 

RT 

RT 

003720 

003730 

003740 

RT 

003760 

RT 

003780 
003790 
003800 
RT003810 
RT003820 
RT0Q3830 
RT003840 
RT00 38 50 
RT003860 
JM 

RT003830 

RT003890 

R TOO 3900 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 
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030220 

j active" , 

RT 

030225 

AT  (16,03), 

FAC(HEX( 84) ) , 

P$(  9)  ,  CH ( 0 3 ) , 

RT 

030230 

AT  (16,08), 

RT 

030235 

'Noun/ verb  . 

function  as  a  noun  or  verb 

RT 

030240 

m 

t 

RT 

030245 

AT  (17,03), 

FAC( HEX( 84 ) ) , 

P$(10)  ,  CH ( 0 3 ) , 

RT 

030250 

AT  (17,08), 

RT 

030255 

'Preposition  . 

JM 

030260 

ments  of  ' , 

JM 

030261 

AT  (18,08), 

JM 

030262 

N 

a  sentence  (e 

g.  in,  on,  oy,  to,  since) 

JM 

030263 

m 

t 

JM 

030265 

AT  (19,03), 

FAC ( HEX  (  84) ) , 

P$(ll)  ,  CH( 03) , 

JM 

030270 

AT  (19,08), 

JM 

030275 

'Pronoun  . 

oe  used  as  a  substitute  fo 

RT 

030280 

r  a  noun", 

RT 

030285 

AT  (20,08), 

JM 

030290 

« 

(e.g.  I,  you. 

she,  what, _ )', 

JM 

030295 

AT  (21,03), 

FAC(H£X(84) ) , 

P$( 12)  ,  CH ( 0 3 ) , 

JM 

030300 

AT  (21,08) , 

JM 

030305 

'Verb  . 

RT 

030315 

AT  (23,20), 

RT 

030320 

'Press', 

RT 

030325 

AT  (23,26), 

FAC(  HEX(  84 )  ) , 

PF 1$  ,  CH( 03) , 

RT 

030330 

AT  (23,30), 

RT 

030335 

'to  return  to  the 

previous  screen', 

RT 

031560 

KEYS ( 8 IN ( 1 ) &8IN( 17 ) ) ,  ON  (d!N( 1 ) &6IN( 17) )  GOTO  AQK,AOK 

RT004I90 

031610 

RT0042U0 

031660 

EXIT:  CLOSE  11 

004210 

031710 

OUT:  /*  RETURNING 

ro  COMMON  WORD  LIST 

MENU  V 

JM 
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Print  Common  Word  List  (CRES@CWP) 


CRESOCWP  in  library  CRES@SRC  is  the  BASIC  language  program  to  print  ttie 
Common  Word  List.  The  object  language  version  io  CRESICWP  in  library  CRES@SAV 

This  program  first  allows  the  user  to  specify  the  word  list  to  be 
printed.  Then  the  program  enables  the  user  to  print  out  either  the  entire 
Common  Word  List,  or  a  specified  portion.  This  printout  can  be  displayed  at 
the  terminal  or  sent  to  the  printer.  An  optional  subtitle  of  up  to  two  lines 
can  be  included  for  the  printout,  and  the  number  of  lines  per  page  may  be 
specified  as  some  value  less  than  the  default  value  of  50. 


A  complete  program  listing  follows, 
f  lowchart . 


Appendix  C  contains  a  sample 


Technical  Report  86-001 


THIS  PAGE  INTENTIONALLY  LEFT  BLANK. 


Technical  Report  86-001 


Wang  VS  Integrated  Editor  -  Version  6.10.00  15:41  11/06/84  Page  1 

Input  Kile  is  CRES@CWP  in  Library  CRES@SRC  on  Volume  CRES02 


000010  /*  rtus  is  the  GRES  COMMON  WUrtU  LIST  PAINT  SUBSYSTEM  PROGRAM  */  JM 
000020  /*  */  AT 
OOUUJU  /*  AUTHORS:  Rose  Tame  and  Join  Mears  */  AT 
000040  /*  Date:  October  12,  1983  V  AT 
000050  /*  */  AT 
000060  AT 
000070  /*  Tlie  following  code  sets  up  a  screen,  which  asks  for  the  */  AT 
000080  /*  name  of  the  file  containing  the  common  word  list  */  AT 
000090  /*  to  oe  printed.  It  also  provides  the  opportunity  to  change  */  AT 
000100  /*  the  library  and  volume  names  which  are  set  to  the  appro-  V  AT 
0001 10  /*  pnate  defaults  through  the  “Extract*  system  routine.  V  RT 
000120  RT 
000 130  AT 
000140  DIM  WOAD$24,EAA1$50,CODE$1,MSG$50,E$40,G$1,CMSG$2S5,MSG2$40  RT 
000150  DIM  Fl$20,IOBUFP$64,EXP$3i,PEILE$06,ALIB$8,RVOL$6  JM 
000160  DIM  TAB$3,BTAB$7,FILE$06,LIB$08,ILIB$08,PLIB$8,PVOL$6  JM 
000170  DIM  IVOL$06,riEADER$51,Ul,V$l,B$i,C$2,D$8,M$l,MSK$2  RT 
000180  DIM  SariTLE$20,A$(14)10,SBTITLl$20,E2$44  JM 
000190  DIM  3J$  05  AT 
000200  DIM  EX$  04  AT 
000210  DIM  £R$  79,M£SSG$21  AT 
000220  DIM  STAATPKS  20  AT 
0002  30  DIM  HNDPHS  20  RT 
000240  DIM  TPf  08  AT 
000250  DIM  PE  15$  04  AT 
000260  DIM  PE  16$  04  AT 
000270  AT 
000260  EN$  -“ENTER*  AT 
000290  A$(l)=  "adjective"  AT 
000300  A$(  2 )  =*  “  verb"  AT 
000310  A$(3)  =  “conjunct'n*  AT 
000320  A$( 4)=  “ad]/ verb"  AT 
000330  A$(5)=  “noun"  AT 
000340  A$( 6) =  “pronoun"  AT 
000350  A$(7)=  "interject"  <  AT 
000360  AS( 8 )=*  "noun/ verb"  AT 
000370  A£(9I~  “adverb"  AT 
000380  A$( 10 ) -"prepos it "  RT 
000390  A$( 11 )=*article"  AT 
0U04J0  A$ ( 12 ) ="ad v/ verb"  AT 
000410  A$(  13)  ="noun/ad  j"  AT 
000420  RT 
000430  TAB$=" TAB"  RT 
000440  BTAB$-"BAO<TAB"  RT 
000450  EXP$=* ( Explanation  uf  Entries  Screen)*  AT 
000460  MESSG$=" Parts  of  Speech  Codes"  AT 
000470  F1$=HEX( 00 14000 1000 1000 1000 JA00100010003000B)  AT 
000480  E$=  "Filename  not  found  on  ( library/ volume).’  AT 
000490  EAR1$=  "r/O  ERROR  -  Please  respecify  a  COMMON  word  list."  AT 
000495  E2$»  “  Please  specify  a  COMMON  word  list."  JM 
000500  CALL  "EXTRACT"  ADDA( "  IV*  ,  IVOL$, "  IL" ,  IuIB$,  "RV“  ,RVOL$,  "SL"  ,  PLI6$,  '.  JM 
000510  *SV",PVOL$,"RL",RLIB$)  JM 
000520  EILE$="CMNUDLST" 

000530  LI6$=ILIB$  JM 
000540  G$=REX(61)  JM 
000550  MSG$="  ’ :L$=HEX(81)  RT 
000560  V$=HEX( 81 ) :  M$=HEX(8D)  RT 


4/ 
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000570 
00U580 
000590 
000600 
000610 
000620 
000630 
000640 
000650 
000660 
000670 
000680 
000690 
000700 
000710 
000720 
000730 
000740 
000750 
000760 
000770 
000780 
000790 
000800 
000810 
000820 
000830 
000840 
000850 
C 30860 
000870 
000880 
000890 
000900 
U0091U 
000920 
0009J0 
000940 
000950 
000960 
000970 
000980 
000990 
001000 
001010 
001020 
001030 
001040 
001U50 
001070 
001080 
001090 
001100 
00111U 
001120 
001130 
00114U 


HEADERS  =*CRES  COMMON  WORD  [.1ST  PRINT  SUBSYSTEM* 
FILS  ="Coinnon  Word  List* 

EX$=*PF16" 

FILMNU: 

ACCEPT 

AT  (01,01), 

"CRES:  Common  Word  List  Print  SuDsystem", 

AT  (01,57), 

'(File  Selection  Screen)*, 

AT  (02,01), 


AT  (04,15), 

"Welcome  to  the*, 

AT  (04,26),  FAC(riEX(35) ), 

HEADERS, 

AT  (07,12), 

"Please  specify  the", 

AT  (07,31),  FAC( HEX(  84 ) ) , 

FILS,  ' 

AT  (07,48), 

"you  want  to  print,", 

AT  (08,18), 

"if  the  default  values  are  not  satisraetory.  ", 

AT  (13,30), 

"File  =", 

AT  ( 13,43), FAC(GS), FILES  ,  01(08), 

RANGE  (  "I  "  ,  "//////if/////" ) , 

AT  (14,30), 

"Liorary  =“, 

AT  (14,43)  ,FAC(L$) ,  LIBS  ,  CH(08>, 

RANGE  (  "I  "  ,  'UUUUttM' ) , 

AT  (15,30), 

"Volume  =■*,  ' 

AT  (15,43) ,FAC( V$) ,  IVOL$  ,  CH(06), 

RANGE  (  "1  "  ,  ttU&tW ) , 

AT  (18,24),  FAC ( M$ ) ,  MSGS, 

AT  (20, 30), "Press", 

AT  (20,36), FAC( HEX( 84 ) ) , 

EN$, 

AT(  20,42), 

"to  continue", 

AT  ( 21, 17) , "Press", 

AT  (21,23),  FAC  ( HEX  ( 84 ) ) , 

EXS , 

AT  ( 21,28)  , 

"to  return  to  the  Common  Word  List  Menu", 

ON  (BIN( 16) &3IN( 32) )  GOIU  OUT 

/*  SET  UP  THE  USER  FILE  BLOCK  */ 

SELECT  f  1 ,  "COMMON" ,  VAKC,  INDEXED,  RECS 1 2E= 40, KEYKJS=i , KEYLEN= 20 , 
IOERR  GOTO  IOERR1 

SELECT  *2, "PRTFILE", PRINTER, RECSIZE=80, IOERR  GOTO  IOERRi 


48 
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00 1150  /*  SKK  II'  IMF.  SPECIFIED  OU  EXISTS  */ 

001160 

001170  CAIC.  *  LIMITS"  (  r  I  i,rl$,  f  .1:1$,  IVOii$,G9DF.$,MSG$ ) 

UOlldU  ie  COO rl$= "  7  "  iMEN  222 

001190  ir  eojfc:$=*N*  toen  ajsaa,7(t-’$,:i-;x(9ijJKEX(dii,iin-<(tUH 

001200  I.’  COOE$="V  nii-Tl  /(SnUAS.wE,  i),,lr:X(di),ilEX(di),iiEXi91)  ) 

001210  lr'  CUDcS=*L"  THEM  OJSdd'  7(STR(MSS$,  3) ,  RKXC  81 ) ,  rtEX(  91)  ,ritIX(di)  > 

001220  I?  COOil$-*E*  rHrllJ  v»JU:),7(srR(MS..I$/  3 ; ,  fli^X  (  8 1  > ,  »liC  <  ( <3 1 1 ,  ilEX  t  d  1  )) 

0012.10  CJJIO  filmnu 
001240 

001250  /•  IF  WE  PAM.  ilERE,  TOP  Pi:..-:  OX; SCI  -  ,)JT  AS  IT  A  CUMMDN  LIST.’ 
001260 

001270  222:  CALL  "READ.-' DR’  ADDRl  r' .  .r-f „Iti$,  IVU1.S  ,0%,  "KS"  ,RAC»  ,Hr.T*.  1 

001290  IF  RAJ*  -40  THEN  221 

001295  GOSUS’  7 (  r'.2$,  HKXv  9 1  )  ,  i:F.X(  (11),  0PX( 81 )  ) 

00129/  a>i\)  r  I  ..MMJ 

001900 

001310  221:  OPSIJ  UOJEI't'ArM  *  1  .SMAHEJ,  rl..r:  rln2$,  L1A4AKV  -  1.1:1$, 
001320  VOIJJMK  -  IVOI.$ 

001330 

001340  READ  *1,  i.JBUrVS,  DATA  JGIO  lJrXrl2 

001360  IP  S  IP!  TOiTIPPf  ,  1  ,  1  6  I  .VX-ltt  >[I  p  )P..)S  "  [MEN  I'rll 

0013/0  CLOSE  »1 

001360  Mi  -;1EX(  94  ) 

001390  MX.vS--  SRRii 

001400  SOTJ  .-CmXO 

001410  7ES: 

0(11420  /*  Tills  sect  Hill  it  c.xJe  g -m;  at  .<  acr  iJmCU  jS» 

001430  /*  tor  tin  particular  word  xir  -rvil  md  its  corronpondiivg 
001440  /*  print  op*ra;  i.h.  Prv  us -r  is  > ,  so  ji  v-*n  trie  option  or 
001460  /*  returning  to  cJw  co.anun  wot  J  list  tvnu. 

001470 

001490  P.Ri  ="  * 

001540  CWMENJ: 

001550  WORDS  --  ’  " 

00  15o0  !.PP*  =  5il 

001570  PF15$  -*1*2 15" 

001580  8.-16$  -VP:0" 

001590  Si3Tin,R$  ="  * 

OOlbOU  SBTH’LIS  =  "  ‘ 

001610  BALONE7: 

001620  TP$  -"TERMINAL" 

001u30  STA3  7  PH$  =*PIRT.r* 

001640  ENDPUS  ="LASr* 

001650  PRINTSCR: 

001660  ACCEPT 

001670  A r  (01,03), 

001680  "CRES:  Common  Word  List  Print  SuDs/stem", 

001690  AT  (01,66), 

001700  "(Print  Screen)’, 

001710  AT  (02,09), 

001720  •  =  =  =  =  =  = 

001730  ==a=======a=«, 

001/40  AT  (04,13), 

001750  "To  print  a  range  of  lines,  fill  in  tne  lntonrution  Delow.", 
001760  AT  (0b, 02),  FAC( riEX( 85 ) I , 

001770  LR$, 
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001780  AT  (08,22), 

001700  "Suotitle  ot  list  =’, 

0018UO  AT  (08,42),  FAC(  HEX(  81 ) )  ,S8TI TLE$,CH(  20) , 

001810  AT  (09,42),  FAC(HEX(31)),SBTirLl$,CH(20), 

001820  AT  (12,22), 

001680  "Starting  word  •=", 

001840  AT  (  12,42),  FAC(HEX(81)  ),  STARTERS,  CH(20), 

001850  RANGE  (  "I  ’  ,  "////////////" ) , 

001860  AT  (18,22), 

001870  "Ending  word  =", 

001380  AT  (13,42),  FAC(  8F.X(81 ) ) ,  ENDPriS ,  Crf(20), 

001890  RANGE  (  ”1  *  , 

001900  AT  (14,22), 

001910  "Lines  par  page  =*, 

001920  AT  (14,42),  r  AC(  HEX(  82) ) ,  LPP4 ,  PIC(M), 

001980  AT  (17,22), 

001940  "Print  at  ( TERM  INAL/  PRINTER)  =", 

001950  AT  (17,58),  FAC( HBX( 81 ) ) ,  TP$,  CH(0d), 

001960  AT  (  22,  82), 

001970  "Press", 

001980  AT  ('22,38),  FAC(  HEX(  85) ) ,  KNS,  01(05), 

001990  AT  (22,44), 

002000  "to  print", 

002010  AT  (23,17), 

002020  "Press", 

002030  AT  (  23,23),  FAC( HEX( 84) ) ,  PF16S,  Cri(04), 

002040  AT  (23,28), 

002050  "to  return  to  the  Common  Nord  last  Menu", 

002060  KEYS( 8TN( 0) &0IN( lb) MINI  32) ), 

002070  ON  (  B 1M (  16 )  68 IN (  32 )  )  GOTO  EXIT, EXIT 

002080  IP  STR( TP$, 1,1)  =  "P"  THEN  NEXT11 

002090  IP  STR(TP$,i,l)  <>  V*  THEN  TERMER 

002100  NHXT11:  IF  LPP%  <  bl  THEN  NEXT! 3 

002110  ERS=“  *  Lines  per  page*  can  ue  at  mast  50." 

002120  C50TO  PRWTSCR 

002160 

0021  70  IUEKR1:  PRINT 

002180  PRINT  HELL, HEX (94), ERR  1$ 

002190  CU3SE  #1 

002200  FOR  1=1  1U  2O0UOO  : NEXT  1 

002210  Q)TO  FILMNU 

002220 

002230  TERMER: 

002240  ER$="' Print  at  '  lus  on!/  legal  values  TERMINAL  or  PRINTER." 

002250  GOTO  PR  IN  TECH 

002260 

00227U  REX:  ERS="  'Starting  word'  comes  after  'Ending  word 

002280  JOI'J  PHIMTSCH 

002290 

002300 

Q02310  K1ERR2:  PRINT 

002320  PRINT  HEX( 94 ), "Error  occurred  on  file  ";  FILES 

002330  PRINT  HEX( 94 ), "Error  code  =  *;  FS(#1) 

002340  SIDE  “Touch  ENTER  to  return  to  menu." 

002350  GO  IV  CWMENU 

002360 

002370  NEXT  1  ):  IF  GTARTPilS  =  " FIRST"  OR  ENDP11$=" LAST"  THEN  FORD 
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002380 

002390 

002400 

002410 

002420 

002430 

002440 

002450 

002460 

002470 

002480 

002490 

002500 

002510 

002512 

002514 

002520 

002530 

002540 

002550 

002560 

002570 

002580 

002590 

002600 

002610 

002620 

002630 

002640 

002650 

0026O0 

002670 
002680 
002690 
002700 
002710 
002/20 
002730 
002740 
002/50 
002760 
002770 
002780 
002790 
002800 
002810 
0U2820 
0028  30 
002840 
002850 
002860 
002870 
002880 
002890 
002900 
002910 
002920 


IF  Si'ARTPHS>F.NDPHS  THEN  REX 
/*  Now  it‘s  time  to  generate  our  print  rile  name  */ 

FORD:  DATS- =  DATE 

DS--=  STR  ( DATS ,  3 , 2 )  &  *  /  "  1..STR  ( D  A  T$ ,  5 ,  2 )  &  "  /  "  S.STR  (  DATS  ,1,2) 
I’S=  STRITIME,  l , 2) &'  :  "fcJTiU  TIME,  3,2 ) 

PFIlE$=“COMi4ND##‘ 

I%=0 

NEXT14  :  Cl  INVERT  I*  IX)  GTR(  PFIi.ES,  7, 2) ,  PiC(  00) 

I*=I*tl 

CALL  "LIMITS*  (  Pr  I i.ES,  PINKS,  PVOI.S,  CODES, MSGS ) 

IF  CODE$=" 2"  THEN  NEXT14 
IF  COOE$=“E"  THEN  ER$  =  S i'R ( MSGS ,  3 ) 

IF  CODES -*E"  THEN  PRINTSCR 

DISPLAY 

AT  (01,03), 

"CRF.S:  CoiLinn  Word  List  Print  SuDu/stem", 

AT  (01,61), 

"  ( Gene rat i dn  Screen ) * , 

AT  (02,03), 


AT  (12,21), 

“Output  tile  now  Doing  generated!" 

OPEN  NOGH i'PARM  1 2 , 00 TROT,  F I . ,E=  PF r  l ,E$ ,  I . T BRAR Y=PL I B$ , 
VOiDMK=PVDI.$,SPAC£=l  5000 
GGSUO  Tl'L  POE 

IF  STAR TPtlS  =  "FIRST"  THEN  STARTPHS  =  ALL( HEX (  00) ) 

IF  ENDi’HS  =  "LAST"  THEN  ENDl’llS  =  ALL(HEX(FF)  ) 

PAGE!  -  1 
RHCS%  =  l 

READ  #1,  KEY>=Si'ARiYHS,  1U13UFFS 
GGSUB  header  < 

IF  STR(  IOBUFFS,  1, 2O)>HN0Pll$  THEN  HOME 
GOOD  KNOT 

AGAN:  READ  »1,  I  CHUFFS,  HOD  GOTO  HOME 

fF  STR(  rOBUFFS,  l,2O)>£N0Pd$  THEN  iiOM£ 

IF  RECS*  -  1  AND  PAGE*  <>  1  THEN  GOSUB  HEADER 
KNOT:  IF  STK(  IOBUFFS,  1,20)="  WORDS"  THEN  AGAN 

PNN=  POS(  *JVCjNOInAPBad"=  STR( IOBUFFS, 21,1)) 

IF  t’SN=0  THEN  P5N=14 

IF  P.8N '  1 4  THEN  AS(  PSN)  -STR(  IOBUFFS,  21,1) 

IF  STR(  TPS,  1  ,  1  )='T'  THEfJ  Bl)G 
-TRITE  »2,  USING  CA  To,  CS,  "  "  ,STR(  IOBUFFS,  1, 2U) , 

AS  ( itlN ) ,  S  TR  (  iOBUr  FS ,  22 , 1 ) ,  S  TK(  IOBUFFS  ,24,1), 

STH(  IOBUFFS, 23, 1 ) 

I F (  SIR (  IOBUFFS ,  26 ,  I  )<>"*’  )  THEN  BAG 

C$=ilEX(  ouou ) 

WRITE  #2,  USING  l'Ai’O,  C$,STH(  IOBUFFS,  1, 20) 

WRITE  *2,  USING  CAT4,  C$,S TR( IOBUFFS, 1 , 20 ) 

CS~HEX(  1)00  -  ) 

CJiM  BAG 

BUv',;  Ir’  S  TR  (  IOBUFFS  THEN  STR( IOBUFFS, 2b, 1 )-* r" 

WRITE  #2,  USING  CATb,CS,Si’R(  IOBUFFS,  26,1)  ,STR(  IOBUFFS,  1,20), 
A$(  l’SN  ) ,  S  .H  (  i'JBUFFS,  22 , 1 )  ,STR(  IOBUFFS,  24 ,  1), 


SI 
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002930 

STR(  IOBUFF$,  23,1) 

RT 

002940 

BAG: 

RECS  i  -RECS  4+1 

RT 

002950 

IF  RECS%>LPP%  THEN  RECS%=1 

RT 

002960 

IF  RECS%=1  TriEN  PAGE%*PAGE% ♦  1 

RT 

002970 

GOTO  AGAN 

RT 

002980 

HOME: 

IF  RF.CS%  =  1  THEN  RECS%=5l 

RT 

002990 

WRITE  #2,  USING  DOG,  C$ 

RT 

003000 

RECS  4  =RECS% + 2 

RT 

003010 

WRITE  #2,  USING  DG,  C$ 

RT 

003020 

FOR  I  =  RF.CS%  00  LPP4+1 

RT 

003030 

WRITE  #2,  USING  DOG,  CS 

003040 

NEXT  I 

003050 

IF  STR( TP$,  1 , 1 )  =  " P“  THEN  HEH1 

003060 

WRITE  |2,  USING  CAT8,  C$ 

003070 

GOTO  HER 

003080 

HEiU: 

WRITE  #2,  USING  RAT,  C$ 

00  309  0 

C$=HEX(0000) 

003100 

FOR  1=1  TO  2 

RT 

U03110 

WRITE  #2,  USING  RATI,  C$ 

003120 

NEXT  I 

003130 

C$4lEX(0001) 

003140 

HER: 

CLOSE  12 

003150 

IF  STR ( TP$ , 1 , 1 )  =*P"  THEN  MESS 

kT 

003160 

CLOSE  WS 

003170 

MSG2S  =  "CANCEL  Processing" 

003180 

MSK$=HEX( 00) 

003190 

CMSG$  =  “  " 

003200 

CALL  "LINK"  ADDR("DISPFILE","P*,RLIB$,RV0L$,3%,PF1LE$,  I 

JM 

003210 

PLIB$,  PVOL$, "C* ,MSG2$, 27%, ‘H* ,MSK$,CMSG$, 255*,C%,R%) 

JM 

003220 

« 

« 

II 

1? 

003230 

if  aou  or  r*oo  : 

003240 

THEN  ER$  =  STK(CMSG$,141) 

003250 

GOTO  CWMENU 

003260 

RT 

003270 

MESS : 

ERi>="  File  " &PF ILE$4"  in  Liorary  "&  PLIB$  f.  "  on  "  I 

JM 

003280 

&PVOLS  6"  generated.' 

JM 

003290 

GOTO  BALONEY 

RT 

003300 

RT 

003370 

TTL  PGE: 

RT 

003380 

C$=HEX( 8001 ) 

RT 

003390 

WRITE  #2,  USING  DOG,  C$ 

RT 

003400 

C $  =  HEX( 0015) 

RT 

003410 

WRITE  12,  USING  DOG,  C$ 

RT 

003420 

C$  =*  HEX(OUUl) 

RT 

003430 

WRITE  #2,  USING  UOG1,  C$ 

RT 

003440 

WRITE  |2,  USING  DOG2,  C$ 

RT 

003450 

WRITE  #2,  USING  LOGO,  C$,D$,KS 

RT 

003460 

WRITE  #2,  USING  LOG3,  C$ 

RT 

003470 

WRITE  12,  USING  DOG2,  C$ 

RT 

003480 

WRITE  |2,  USING  DOG1,  C$ 

RT 

003490 

WRITE  |2,  USING  DOG2,  C$ 

RT 

003500 

IF  StJTI TLE$  =  “  *  THEN  GERRY 

RT 

003510 

WRITE  12,  USING  DOG4,  C$,  SBTITLE$ 

RT 

003520 

IF  SOTITLISO"  "  THEN  WRITE  |2,  USING 

RT 

003530 

DOG10, 

C$,  SBITXLIS 

RT 

003540 

WRITE  |2,  USING  DOG2,  C $ 

RT 

003550 

GERRY : 

WRITE  12,  USING  DOG5,  C$,  FILES 

RT 

b/ 
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001660  WRITE  #2,  USING  DOG2,  C$  RT 
003570  WRITE  #2,  USING  DOG6,  C$,  LIB$  RT 
003580  WRITE  #2,  USING  DOG2,  C$  RT 
003590  WRITE  *2,  USING  DOG7,  C$;  IVOL$  RT 
003600  WRITE  |2,  USING  DOG2,  CS  RT 
003610  WRITE  #2,  USING  DOG8,  C$,  STARTPH$  RT 
003620  WRITE  #2,  USING  D0G2,  C$  RT 
003630  WRITE  #2,  USING  DOG9,  C$,  ENQPH$  RT 
003640  WRITE  #2,  USING  DOG2,  C$  RT 
003650  WRITE  #2,  USING  DOG1,  C$  RT 
003660  RETURN  RT 
003670  •  RT 
003680  HEADER:  RT 


003690  IF  PAGE%=1  THEN  FIRST 

003700  C$  =  REX(OOOl) 

003710  IF  snUTP$,i,l)=*P"  THEN  FRST1 

003720  WRITE  #2,  USING  1XJG,  C$ 

003730  'WRITS  *2,  USING  CATS,  C$ 

003740  GOTO  FIRST 

003750  FRST1 :  WRITE  »2,  USING  RAT,  C$ 

003760  C$=8!fcx(0000) 


003770  FOR  1=1  TO  2  RT 

003780  WRITE  #2,  USING  RATI,  C$ 

003790  NEXT  I 

003800  C$=HEX(0Q01) 

003810  FIRST:  CS  =  HEX(80Q1)  RT 

003820  WRITE  #2,  USING  DOG,  C$  RT 

003830  C$  =  HEX(0001J  RT 

003840  IF  SBTITL&J  =  *  *  1  RT 

003850  THEN  WRITS  12,  USING  CAT, C$,D$,'T$, PAGE*  J  RT 

003860  ELSE  GOTO  FOUT  RT 

003870  GOTO  ALRITE  RT 

003880  FOOT:  WRITE  #2,  USING  CAT1,C$,SBTITLE$,D$,T$,PAGE%  RT 

003890  IF  SBTITL1$<>"  *  1  RT 

003900  THEN  WRITE  #2,  USING  CAT7 , C$ , SB FrTLi$  RT 

003910  ALRITE:  WRITE  #2,  USING  CAT2,  C$,  FILES,  Ud$,  IVOLt  RT 

003920  WRITE  #2,  USING  CAT 3,  C$  RT 

003930  WRITE  #2,  USING  CAT4,  C$  RT 

001940  WRITE  #2,  USING  CAT5,  C$  RT 

003950  WRITE  #2,  USING  CAT 3,  C$  RT 

003960  RETURN  RT 

003970  RT 

003980  DOG0:%»*  #*»l#i*tt  *.  RT 

001990  l»»|t  !  RT 

004000  DOG:  %##  RT 

004010  dg:%#»  :: :  end  of  listing  :t:  rt 

004020  DOGl:%»#  - RT 

004010  - :  RT 

004040  DOG2:%##  !  RT 

004050  :  RT 

004060  DOG3:%»#  ******  COMMON  WORD  LIST  ****!  RT 

004070  *  1  RT 

004080  DOG4:%M  1  TITLE  OF  LIST:  ***»»»»*§*****#*:  RT 

004090  till  I  RT 

004100  DOG5:%M  !  INPUT  FILE:  HHtttt  l  RT 

004110  RT 

004L20  DOG6:%l|  I  INPUT  LIBRTVRy :  tHIUtt  !  RT 


63 
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004 1  jo  :  rt 
004140  OOG7 :  %##  INPUT  VOLUME:  ######  t  RT 
004150  I  RT 
004160  DOG8:%##  I  STARTING  WORD:  ft########*#####:  RT 
004170  ####  I  RT 
004180  DOG9:%##  I  ENDING  WORD:  ################:  RT 
004190  ####  I  RT 
004200  DOG10:«##  ft#####)### fill:  RT 
004210  #####  I  RT 
004220  CAT:%##  »#######  ####(  1  RT 
004230  PAGE  #>###  RT 
004240  CAT1:%##  TITLE  OE  LIST  :  #**#«#****###»###*##  ##>#(»##  RT 
004250  ##»##  PAGE  #####  RT 
004260  CAT7 : % # #  »#»>>»>#»###»#»»>#»*  RT 
004270  CAT2:%##  Input  Pile  is  ######»#  in  Library  ####(###  on  Volume  («#:  RT 
004280  »#«  RT 
004290  CATj  :%##======================================================:  RT 

004300  =====================  RT 

004310  CAT4:*##  vflRD  Part  of  Past  To  RT 
004320  Be  Negative  RT 
004330  CAT5:%##  '  Speech  Participle  RT 
004340  CAT6 : % # #  #  #######>###»##>»#>(#  ###»#####»  «  »!  RT 
004350  #  RT 
004360  CAT9:%#>  #*##**•*#>»»*##*«***  RT 
004370  CAT8 : % # #  t  =  ROOT  viORD  RT 
004380  RAT : % # #  BOLDFACE  =  Root  Word 

004390  h  .21:%##  BOLDFACE  RT 
004400  RT 
004410  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */  RT 
004420  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  V  RT 
0U4430  DEF  FN'7(MSG$,B$,C$,D$)  RT 
004440  PRINT  RT 
004450  M$=HEX( 94 )  RT 
004460  G$=B$  kT 
UU44/0  L$=C$  -  RT 
004480  V$=D$  RT 
004490  RETURN  RT 
004500  RT 
004110  EXIT:  CLOSE  #1  RT 
004520  OUT:  /*  RETURNING  IO  COMMON  WORD  LIST  MENU  */  .JM 


CRES@CPA  in  library  CRES0SRC  is  the  BASIC  language  program  to  print  the 
Common  Word  List  by  attribute.  The  object  language  version  is  CRESldCPA  in 
library  CRES@SAV. 

This  program  first  allows  the  user  to  specify  the  word  list  to  be  printed 
and  the  attributes,  (part  of  speech,  past  participle,  form  of  the  verb  "to 
be",  negative  or  root  word)  to  be  included.  See  table  1  for  a  definition  of 
the  parts  of  speech. 

If  a  particular  part  of  speech  is  selected  which  also  appears  in 
combination  with  some  other  part(s)  of  speech,  all  combinations  which  contain 
the  originally  specified  part  of  speech  will  be  included.  (For  example, 
selecting  verb  will  produce  a  list  of  verbs,  adverb/verbs,  noun/verbs,  ana 
adjective/verbs.)  More  than  one  attribute  can  be  selected,  and  all  words 
containing  any  attribute  selected  will  be  included  in  the  printout.  If  the 
root  word  attribute  is  selected  in  combination  with  another  attribute,  then 
only  root  words  possessing  that  attribute  will  be  printed. 

The  user  can  select  a  subtitle  of  up  to  two  lines  to  be  printed  on  each 
page  of  the  output  listing.  The  output  listing  can  be  sent  to  either  the 
terminal  or  the  printer,  it  can  encompass  the  entire  output  list  generated,  or 
any  portion  of  the  list,  and  the  number  of  lines  per  page  can  be  specified. 


A  complete  program  listing  follows.  Appendix  C  contains  a  sample  flow 
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000010  /‘This  is  the  CRES  COMMON  WORD  LIST  PRINT  8*  ATTRIBUTE  PROGRAM  »/  JM 
000020  /*  V 

000030  /*  AUTHOR:  Rose  Tame  */  JM 

000040  /*  Date:  January  12,  1984  */  JM 

000050  /*  V 

000060 

000070  /*  The  following  code  sets  up  a  screen,  wnich  asKs  tor  the  */ 

000080  /*  name  of  the  file  containing  the  common  word  list  */ 

000090  /*  to  De  printed.  It  also  provides  the  opportunity  to  change  */ 

000100  /‘the  liorary  and  volume  names  which  are  set  to  the  appro-  */ 

000110  /*  priate  defaults  through  tne  “Extract"  system  routine.  */ 

000120 

000130 

000140  DIM  WORDS24,ERRiS60,GODE$l,MSG$5U,FS4Q,G$l,CMSG$255,MSG2$40 

000150  DIM  F1$20,IOBUFF$64,RVOLS06,PFILE$08,FILE$8,ILIB$8,IVOL$6  JM 

000160  DIM  ENTER$5,PP14$4,PF15$4,PF16$4,ER$79,RLI8$8,E2$37  JM 

000170  DIM  HEADERS51,L$l,V$l,a$l,C$2,D$8,M$l,MSK$2,MSGi$50 

000180  DIM  SBTITLES20, AS(  20 )  15,SBTITL1$20,STARTPH$20,ENDPH$20,TP$8 

000190  DIM  PSPCriT$15,arH£KS$16,T$(20)l,X$l,SLIB$8,SVDU6  JM 


000200 

000210  AS(1)=  “adjfective" 
000220  AS(2)=  "vero" 
000230  AS(3)  =  "conjunct." 
000240  A$(4)=  "adj/verD" 
000250  A$(5)=  "noun" 
000260  AS(6)=  "pronoun" 
000270  AS(7)  =  “interject" 
000280  AS( 8)=  "noun/verh" 
000290  AS(9)=  "adverb" 
000300  AS(  10)=="preposit" 
000310  Ai(ll)="article" 
000320  AS(12)=*adv/verb* 


000330  AS(13)="noun/udj"  RT 

000340  A$(14)=*past  participle"  RT 

000350  AS( 15) =" to  he"  ,  RT 

000360  AS(  16)="uegative"  RT 

000370  A$( 17) ="root  word"  RT 

000380 

000390  F1$=HEX(  00140001U0010UU100U JAOOIUOOIUUU 30008) 

000400  EWTER$=" ENTER" :  PF14S  ="PF14"  :PF15$=*PFi5" :PF16S="PF16"  RT 

000410  ATIR I BUTES$= " ATTR I BUTES"  RT 

000420  PSPCTITS  ="parts  of  Speech" 

000430  OTHERSS  ="Othcr  Attributes" 

000440  X$="X"  RT 

000450  F$=  "Filename  not  found  on  ( 1 lorary/volume) . " 

000460  ERR1$=  "I/O  ERROR  -  Please  respecify  a  COMMON  word  list." 

000470  HEADERS  =“CRES  PRINT  BY  ATTRIBUTE  SUBSYSTEM* 

000480  E2$=  "  Please  specify  a  COMMON  word  list."  JM 

000490  FILS  ="Cominon  Word  List" 

000500  CALL  "EXTRACT"  ADDR(  "HV"  ,RVOL$,  "RL"  ,RLIS$,  "IL" ,  ILIBS,  "  IV"  ,  IVULS,  JM 
000510  "SL’,SLIB$,"SV",SVOLS)  JM 

000520  FILE$="CMNWDLST" 

000530  G$=H£X( 81 )  JM 

000540  MSG$="  " : L$=HEX(  81 ) 

000550  V$=HSX( 81 J :  M$=HEX(8D) 

000560 

000570  FI1J4NU : 
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000580  ACCEPT 

000590  AT  (01,01), 

000600  "CRES:  Print  Common  Words  oy  Attrioute  Suosystein*, 

000610  AT  (01,57), 

000620  "(Pile  Selection  Screen)*, 

000630  AT  (02,01), 

000650  =============“, 

000660  AT  (04,17), 

000670  “Welcome  to  the", 

000680  AT  (04,28),  FAC(HKX( 85) ) , 

000690  HEADERS, 

000700  AT  (07,14), 

000710  “Please  specify  the", 

000720  AT  (07,33),  FAC(HEX(84) ) , 

000730  FILS, 

000740  AT  (07,50), 

000750  “you  want  to  print,', 

000760  AT  (08,18), 

000770  “if  the  default  values  are  not  satisfactory.’, 

000780  AT  fl3,3U), 

000790  “File  =“, 

000800  AT  ( 13,43), FAC(G$), FILES  ,  01(08), 

000810  RANGE  (  “!  *  ,  '£££££££££.£££' ) , 

000820  AT  (14,30), 

000830  “Library  =*, 

000840  AT  ( 14,43) , FAC( LS) ,  ILIB$  ,  CH(08), 

000850  RANGE  (  “*.  “  ,  '££££££££££££'), 

000860  AT  (15,30), 

000870  “Volume 

000880  AT  ( 15,43) ,FAC(V$) ,  IVULS  ,  CH(06), 

000890  RANGE  (  “I  *  ,  ’££££££££££££'), 

000900  AT  (18,24),  FAC(MS),  MSG$, 

0009 L0  AT  (20, 30), “Press*, 

000920  AT  (20,36) ,FAC( HEX ( 84) ) ,  - 

000930  ENTERS, 

000940  AT( 20,42)  , 

000950  “to  continue", 

000960  AT  (2 1,1 7), "Press*, 

000970  AT  (21,23),  FAC( HEX( 84) ) , 

000980  PF16S, 

000990  AT  (21,28), 

001000  "to  return  to  the  Common  List  Word  Menu", 

001010  ON  (6IN( 16)&BIN( 32) )  GOTO  OUT, OUT 
001030 

001040  M$=HF.X(8D) 

0U1041 

001050  /*  SET  UP  THE  USER  FILE  BLOCK  */ 

UU1060 

001070  SELECT  11,  “COMMON*,  VARC,  INDEXED, RECSIZS=40, KEYPOS=l  ,KEyLF.N=20 

001080  IOERR  GOTO  IOERR1 

001090 

001100  SELECT  |2, “PRTFILE", PRINTER, RECSIZE=80, IOERR  GOTO  IOERR1 
001110 

001120  /*  SEE  IP  THE  SPECIFIED  FILE  EXISTS  V 
001130 

001140  CALL  "LIMITS’ ( FILES, ILI3S, IVOlS,CODES,MSG$) 
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001150  IP  COD£$="V"  THEN  111 

001160  IF  i_ODE*="N"  THEN  GOSUB' 7(F*,HEX(91),HEX(81) ,HEX(81) ) 

001170  IF  OODE$= "  V"  THEN  GOSUB' 7(STR(MSG$, 3) , HEX(81)  ,HEX( 81 ) ,HEX( 91 ) ) 

001180  IF  O DDE*="L"  THEN  GOSUB' 7(S'TR(MSG$,  3)  ,H£X(8.L)  ,HEX(  91)  ,HEX(  81) ) 

001190  IF  C0DE$=*E*  THEN  OOSU3' 7(STR(MSG$, 3) ,HEX(81)  ,HEX(81) ,HEX( 81 ) ) 

001200  GOK)  FILMNU 
001210 

001220  ,  *  IF  WE  FALL  HERE,  OUR  FILE  EXISTS  -  BUT  IS  IT  COMMON  WORDS?  */  JM 


001230 

001240  ZZZ:  CALL  -READFDR*  ADDR( FILES, ILIB$, IVQL*,0%, "RS" , RAG*, RETi )  JM 
001250  IP  RAG%=40  THEN  ZZ1  *  JM 
001260  GOSUB' 7 ( E2*,HEX( 9i ) , HEX( 81) , HEX(8I ) )  JM 
001261  GOTO  FILMNU  JM 
001270  ZZ1:  OPEN  NOGETPARM  #1, SHARED,  FILE=  FILE*,  LIBRARY  =  ILIB$,  1  JM 


001280  VOLUME  =  IVDL* 

001290 

001300  READ  *i,IOOUFF$,  DATA  GOTO  IOERR2 

001310  IF  STR ( IOBUFF$ , , 1 3 ) ="  COMMON  WORDS"  THEN  1ES 

001320  CLOSE  #1 

001330  M$=HEX( 94  J 

001340  MSG*=  'ERR1* 

001350  GOTO  FILMNU 

001360  FES: 


001370  X$="X“ :  RTFL=0:  FOR  1=1  TO  i7:  T*(I)="  " : NEXT  I  RT 

001380 

001390  ACCEPT  I  RT 

001400  AT  (01,03),  I  RT 

001410  "CRES:  Print  Common  Words  ny  AttriDute  Subsystem  (Attribute  Sale)  JM 
001420  ction  Screen)’,  I  RT 

001430  AT  (02,03),  '.  RT 

00 1440  *=a3335aa==3===53  ====  ===?==3=5=33a  ==3=S3S3aa33a=a=353=:==s===5==  [  RT 

001450  =============",  :  RT 

001460  AT  (04,03),  !  RT 

001470  "  Place  an",  !  RT 

001480  AT  (04, 14) ,FAC(HEX(85) ) ,X$,  CH(0i),  I  RT 

001490  AT  (04,16),  !  RT 

001500  "beside  thi  attribute  or  combination  of  attributes  to  be  printed.!  RT 
00151U  ",  1  RT 

001520  AT  (06,03),  !  RT 

001530  "If  you  choose  a  part  of  speecn  which  is  included  in  a  conoinatio!  RT 
001540  n,  then  the",  !  RT 

001550  AT  (06,03),  !  RT 

001560  "combination  will  also  be  printed,  (e.g.  If  adverb  is  selected  tb.‘  RT 
001570  en  adv/ verbs",  !  RT 

001580  AT  C07,03) ,  !  RT 

001590  "will  printed  as  well  as  the  adverbs.)  If  the  coot  word  option  i!  RT 
001600  s  selected  in",  !  RT 

001610  AT  (08,03),  !  RT 

001620  "combination  with  another  attribute,  then  only  toot  words  with  th!  RT 
001630  at  attribute",  !  RT 

001640  AT  (09,03),  !  RT 

001650  "will  be  printed.",  !  RT 

001660  AT  (11,37),  FAC(HEX(AD)),  ATTRIBUTES*  ,  CH(10),  !  RT 

001670  AT  (13,14),  FAC( HEX( AC ) ) ,  PSPCTIT*  ,  CH(15),  !  RT 

001680  AT  (13,55),  FAC( HEX( AC) ) ,  OTHERS*  ,  CH ( 1 6 ) ,  !  RT 

001690  AT  (14,05),  !  RT 

001700  "adjective",  .'  RT 
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001710  AT  (14, Id),  r'AC(  HEX(  81) ) ,  T$(l)  ,  C 

001720  AT  (14,24), 

001730  "noun/vero", 

001740  AT  (14,36),  PACl HEX(  81 ) ) ,  T$(8)  ,  C 

001750  AT  (14,55), 

001760  'past  participle", 

001770  AT  (14,71),  FAC( HSX( 81 ) ) ,  T$(14)  ,  C 

001780  AT  (15,05), 

001790  "vero", 

001800  AT  (15,18),  PAC(HEX(81) ),  T$(2)  ,  C 

001810  AT  (15,24), 

001820  "adverD", 

001830  AT  (15,36),  FAC(HEX(81) ) ,  T$(9)  ,  C 

001840  AT  (15,55), 

001850  "to  oe", 

001860  AT  (15,71),  FAC( HBX( 81) ) ,  T$ ( 15)  ,  C 

001870  AT  (16,05), 

001880  "conjunction", 

001890  AT  (16,18),  FAC( HEX( 81 ) ) ,  T$(3)  ,  0 

001900  AT  (16,24), 

001910  "prepositx on", 

001920  AT  (16,36),  FAC(  HEX(  81 ) ) ,  T$(10)  ,  Cl 

001930  AT  (16,55), 

001940  "negative", 

001950  AT  (16,71),  FAC( HEX( 81) ) ,  T$(ib)  ,  C 

001960  AT  (17,05), 

001970  "adj/verb", 

001980  AT  (17,18),  FAC(HEX(81) ),  T$(4)  ,  0 

001990  AT  (17,24), 

002000  "article", 

002010  AT  (17,36),  FAC(  8EX( 81)  ) ,  T$(ll)  ,  Cl 

002020  AT  (17,55), 

002030  "root  word", 

002040  AT  (17,71),  FAC(  HEX(81 ) ) ,  T$(17)  ,  Cl 

002050  AT  (18,05), 

002060  "noun", 

002070  AT  (18,18),  FAC(  HEX(  81 )  ) ,  T$(5)  ,  Cl 

002080  AT  (18,24), 

002090  "adv/vero", 

002100  AT  (18,36),  FAC(  HEX(  81 ) ) ,  T$(12)  ,  Cl 

002110  AT  (19,05), 

002120  "pronoun", 

002130  AT  (19,18),  FAC( HEX( 81) ) ,  T$(6)  ,  Cl 

002140  AT  (19,24), 

002150  * noun/ad j", 

002160  AT  (19,36),  FAC(  HEX181 ) ) ,  T*  ( 13)  ,  Cl 

002170  AT  (20,05), 

002180  "interjection", 

002190  AT  (20,18),  FAC(HKX(81) ),  Tt(7)  ,  Cl 

002200  AT  (21,24),  FAC(M$),  MSG$  ,  Cl 

002210  AT  (23,30), 

002220  "Press’, 

002230  AT  (  23,36),  FAC(  HEX(  85) ) ,  ENTERS  ,  Cl 

002240  AT  (23,42), 

002250  "to  continue", 

002260  AT  (24,17), 

002270  "Press", 
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002280 

002290 

002300 

002310 

002320 

002330 

002340 

002350 

002360 

002370 

002380 

002390 

002400 

002410 

002420 

002430 

002440 

002450 

002460 

002470 

002480 

002490 

002500 

002510 

002520 

002530 

002540 

002550 

002560 

002570 

002580 

002590 

002600 

002610 

002620 

002630 

002640 

002b50 

002660 

002670 

002680 

002690 

00270F 

002710 

002720 

002730 

002740 

002750 

002760 

002770 

002780 

002790 

002600 

002810 

002820 

002830 

002840 


AT  (24,23),  FAC( H£X(  84) ) ,  PF16$  ,  CH(Q4),  JM 

AT  (24,28),  l  JM 

•to  return  to  the  Common  Word  List  Menu",  I  JM 

KEYS(BIN( 0) 4BIN( lb ) SB IN (  32) ) ,  1  JM 

ON  (8IN( 16) 4BIN( 32) )  GOIO  EXIT,EXIT  JM 

MSG$=*  *:M$=HEX(80):  K=0 

FOR  I  =  1  TO  17  RT 


PSN=PQS ( "  X"='T$(I>) 
IF  PSN=0  THEN  INPTER 
IF  PSN=2  THEN  K=1 
NEXT  I 


IF  K=1  THEN  2460  JM 

IF  K=0  AND  T$(  17)  =  “X*  THEN  RTFL=2  ELSE  INPTER  RT 

GOTO  2460  JM 

INPTER:  MSG$=*Piease  use  only  'X'  to  mark  attributes." 

M$=HEX(  94) :  GOTO  5fES 

IF  T$(1)0"X"  THEN  2480  /"If  adj  was  marKed  then  */  JM 

T$(4)="X":  T$(13)="X"  /"also  print  adj/verb  4  nourj/adj*/  RT 

IF  T$(2K>"ft*  THEN  2510  /"If  verb  was  marked  then  also  */  JM 

T$(4)=*X":  T$( 8)="X" :  T$( 12)=*X*/*print  adj/verb,  noun/verb"/  RT 

/*  4  adv/vern  */  RT 

IF  T$(  5)0  "X"  THEN  2530  /"If  noun  was  marked  tl*>n  also  */  JM 

T$(8)="X":  T$(  13)="X“  /"print  noun/vetD  4  noun/adj  */  RT 

IF  T$(9)="X*  THEN  T$(  12)  =*X"  /"If  adv  was  marked  then  also  »/  RT 

/"print  adv/vero  */  RT 

RT 

FOR  I  =14  TO  16:  IF  X$(I)=*X"  THEN  T$U)  =  '*'  ELSE  T$(  1  )="$"  :NEXX  I  RT 
IF  K=1  AND  T$( 17)="X"  THEN  HTFL=1  RT 

/*  This  section  of  code  generates  another  screen,  whicn  asks  */  JM 

/*  for  the  particular  word  interval  and  the  corresponding  */  JM 

/*  print  operation.  Tne  user  is  given  the  option  of  returning  */ 

/*  to  the  previous  screen  to  select  new  attributes  to  print,  */  JM 

/*  or  of  returning  to  the  common, word  list  menu.  */  JM 


ER$  ="  " 
CWMENU: 

WORDS  =  "  " 
LPP% 

PF15$ 

PF16$ 

SBTXTL E$ 

SBTi TL1$ 
SAL0NEV : 

TP$ 

STARTPHS 

ENDPH$ 

PRINTSCR: 

ACCEPT 


=  50 

=*PF15* 

="PF16" 


“"TERMINAL" 
=" FIRST* 
“"LAST" 


AT  (01,03), 

"CRES:  Print  Common  Words  oy  Attribute  Subsystem" 
AT  (01,66), 

"(Print  Screen)", 

AT  (02,03), 


JM 
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002850  =====»===■====’, 

002860  AT  (04,13), 

002870  "To  print  a  range  of  lines,  fill  in  the  information  below.’, 

002880  Af  ( U6,02) ,  FAC(HEX(8S) ) , 

002890  ER$, 

002900  Ar  (08,22), 

002910  ’Subtitle  of  list  =*, 

002920  AT  (08,42),  FAC( HEX( 81 ) ) ,SBTTTL£$,CH( 2U) , 

002930  AT  (09,42),  FAC(H£X(8I) ) ,SBriTLl$, CH( 20) , 

0U2940  AT  (12,22), 

002950  ’Starting  word  =*, 

002960  AT  (12,42), FAC ( HEX ( 8 1 ) ) ,  STARTPH$,  CH(20), 

002970  RANGE  (V  *  ,  *###/###’), 

002980  AT  (13,22), 

002990  ’Ending  word  =*, 

003000  AT  (13,42),  FAC( HEX( 81 ) ) ,  ENQPH$,  CH(20), 

003010  RANGE  (  ’!  *  ,  '££££££££££££' ) , 

003020  AT  (14,22), 

003030  "Tines  per  page  =*, 

0U3040  AT  (14,42),  FAC(HEX(82) ) ,  LPP4,  PIC(##), 

003050  AT  (*17,22), 

003060  ’Print  at  (TERM INAL/PR INTER)  =*, 

003070  AT  (17,53),  FAC(HEX(81) ) ,  TP$,  CH(08), 

003030  AT  (22,32), 

003090  "Press’, 

003100  AT  (22,38),  FAC(HEX(85) ) ,  ENTERS  ,  Cri(05), 

003110  AT  (22,44), 

003120  "to  print’, 

003130  AT  (23,24), 

003140  ’Press", 

003150  AT  (  23, 30) ,FAC( HEX( 85) ) , PF15$,CH( 04) , 

003160  AT  (23,35),  "to  select  new  attributes’, 

003170  AT  (24,19), 

003180  "Press’, 

003190  AT  (24,25),  FACl HEX( 34 ) ) , -PF16$,  Crt(04), 

00)200  AT  (  24,30), 

00  3210  "to  return  to  Coimon  Word  List  Menu", 

UU3220  KEfS( 8IN(  0 )  6dIN(  16 )  &8IN(  32)  &81N(  15)  WIN(  31 ))  , 

003230  ON  ( BIN ( 16) &BIN( 32)&BIN(15)6riIN( 31) )  GOTO  EXIT, EXIT, fES, YES 
003240 
003250 
003260 

00  3270  NF.XT11: 

003280 
003290 
003)00 

003310  IOERR1: 

003320 
003330 
003340 
003350 
003360 

003370  IERMPR: 

003380  SR$-"'Prmt  at  '  las  on!/  legal  values  TERMINAL  or  PRINTER.’ 

003390  GOTO  PRINTSCR 

003400 

00  3410  REX:  F.R$=*  'Starting  word'  comes  after  'Ending  word'.’ 


IF  STR(TP$,  1 , 1 )  =  *P*  THEN  NEXT11 

IF  STR ( l’P$ ,  1 , 1 )  <  >  *T*  THEN  TERMPH 

IF  LPP%  <  51  THEN  NEXT13 

ER$=”  Lines  per  page'  can  ue  at  mist  50. 

GOTO  PRINTSCR 


PRINT 

PRINT  JELL, HEX( 94 ) , ERR1$ 
CLOSE  #1 

FOR  1=1  IO  2UOOOO  :NEXT  I 
GOIU  FILMNU 


JM 

JM 

JM 

JM 

JM 

JM 


JM 

JM 

JM 
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003420 

003430 

003440 

003450 

003460 

003470 

003480 

003490 

003500 

003510 

003520 

003530 

003540 

00355U 

003560 

003570 

003580 

003590 

003600 

003610 

003620 

003630 

003640 

003650 

003652 

003654 

003660 

003670 

003680 

003690 

003700 

003710 

003720 

003730 

003740 

003750 

003760 

003770 

003780 

003790 

003000 

003810 

003820 

003830 

003840 

003850 

003860 

003870 

003880 

003890 

003900 

003910 

003920 

003930 

003935 

003940 

003950 


GOTO  PRINTSCR 


IOERR2:  PRINT 

PRINT  HEX( 94) , "Error  occurred  on  file  FILES 
PRINT  HEX( 94), "Error  code  =  *;  PS(#1) 

STOP  "Pouch  ENTER  to  return  to  menu." 

GOTO  CWMENU 

NEXT13:  IF  ST  ART  Pri$= "FIRST"  OR  ENDPH$=" LAST"  THEN  FORD 
IF  STARTPH$>ENDPH$  THEN  REX 

/*  Now  it's  time  to  generate  our  print  file  name  */ 

FORD:  DATS=  DATE 

D$=  STR(DAr$,3,2)S>*/"t<STR(DA'r$,5,2)4i"/"&STR(DAr$,l/2) 
T$=  STR(  TIME,  1, 2)  6":  *&STR(TIME,3,2) 

PFILE$=’CATRia#»" 

I%=0 

NEXT14:  CONVERT  I*  lO  STR( PFILES, 7, 2) ,PIC( 00) 

I%  =  I*  +  1 

CALL  "LIMITS"  (  PFILES, SLIB$,SVOLS, CODES, MSG1S) 

IF  OJDES=“Y"  THEN  NEXT14 
IF  CODES="E"  THEN  ERS  =  STR(MSG$,3) 

IF  CODE$="E"  THEN  PRINTSCR 

DISPLAY 

AT  (01,03), 

"CRES:  Print  Cortmon  Words  oy  Attrioute  Subsystem", 

AT  (01,61), 

“(Generation  Screen)*, 

AT  (02,03), 


AT  ( 12' 23) , 

"Output  file  now  being  generated’." 

OPEN  NOGETPARM  #2,OUTPUT,FILE=PFlLE$,LIBRARY=SLiaS, 
VULUME=SVOLS ,  SPACE=1 5000 
GOSUfl  TTL_PGE 

IF  STARTPriS  =  "FIRST"  THEN  STARTPHS  =  ALL(HEX(00)) 
IF  ENDPHS  =  "LAST"  THEN  ENDPHS  =  ALL(HEX(FF) ) 

PAGE*  =  1 
RECS*  =  1 

READ  #1,  KEY>=STARTP!l$,IOBUFF$ 

IF  STR(  I08UFFS,  1, 20 )>ENDPHS  THEN  HOME 
IF  STR(  IOBUFFS,  1,20)="  COMMON  WORDS"  THEN  AGAN 
KNOT:  IF  RTFLOl  THEN  3880 

IF  STR(  IOBUFFS,  26, 1)0"*"  THEN  AGAN 

PSN=  POS("J  :jNOInAPBad"=  STR( IOBUFFS, 21,1) ) 

IF  TS( PSN) ="X*  THEN  3950 

IF  T$(  14  )=STR(  IOBUFFS,  22,1)  THEN  3950 

IF  T$(15)=STR(IOdUFF$,24,l)  THEN  3950 

IF  TS(16)=STR( IOBUFFS, 23,1)  THEN  3950 

IF  RTFL=2  AND  STR( IOBUFFS, 26, 1 )=" *"  THEN  3950 

IF  T$(  17)="X"  AND  STR(  IOBUFFS, 26,1)=**"  THEN  3950 

GOTO  AGAN 

IP  RECS%  =  L  THEN  OOSU8  HEADER 


JM 


JM 

JM 

JM 


JM 

JM 

JM 


JM 


RT 

JM 

JM 

JM 

JM 

JM 

JM 
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000960 

003970 

003980 

003990 

004000 

004010 

004020 

004030 

004040 

004050 

004060 

004070  BUG: 

004080 

004090 

004100 

004110  BAG: 

004120 

004130 

004140  AGAN: 

004150 

004160 

004170  HOME: 

004180 

004190 

004200 

004210 

004220 

004230 

004240 

004250 

004260 


IF  STR(TPi,l,l)=*r  THEN  BUG 
WRITE  |2,  USING  IM36,C$,  ”  * ,STR( IOBUFFS, 1,20) , 

AS(PSN)  ,STR(  IOBUFFS,  22, 1)  ,S'K(  IOBUFFS,  24,1), 

STR( IOBUFFS, 23,1) 

IF(STR( IOBUFFS, 26,1 )<>**“ )THEN  BAG 
IF  RTFL  <>  0  THEN  BAG 
CS=HEX( 0000 ) 

WRITE  #2,  USING  IMG9,  C$,STR( IOBUFFS, 1, 20) 

WRITE  #2,  USING  IMG9,  CS,STR( IOBUFFS, 1, 20) 

C$=HEX( 0001 ) 

GOTO  BAG 

IF  STR(  IOBUFFS, 26,1)=****  THEN  STR(  IOBUFFS, 26,1)=“+* 

WRITE  #2,  USING  IMG6,C$,STR(  IOBUFFS, 26, 1)  ,STR(  IOBUFFS,  1, 20) 
AS(  PSN ) ,STR( IOBUFFS, 22, 1 ) ,STR( IOBUFFS, 24 , 1 ) , 

STR( IOBUFFS, 23,1) 

RECS*=RECS*+1 

IF  RECS%>LPP%  THEN  RECS%=1 

IF  RECS%=1  THEN  PAGE*=PAGE%+1 

READ  11,  IOBUFFS, EOD  GOTO  HOME 

IF  STH( IOBUFFS, 1, 20 )>ENDPHS  THEN  HOME 

GOlt)  KNOT 

IF  RECS%=1  THEN  RECS%=51 
WRITE  #2,  USING  TIT,  CS 
RECS*=RECS%+2 
WRITE  *2,  USING  DG,  C$ 

FOR  I  =  REGS'*  TO  LPP*+1 
WRITE  12,  USING  TIT,  C$ 

NEXT  I 

IF  STRUT'S,  l,l)  =  *p"  THEN  HER1 
WRITE  #2,  USING  IMG8,  CS 
GOTO  HER 


004270  HER  1 :  IF  RTFLOO  THEN  tIER:  WRITE  fy,  USING  RT,  HEX(U002) 


004280 

C$=HEX( OUUO ) 

004290 

FUR  1=1  TO  2 

004300 

WRITE  |2,  USING  RTi,  CS  - 

004310 

NEXT  I 

004320 

C$=HEX( 0001 ) 

004330 

HER: 

CIGSE  #2 

004340 

IF  STR(TP$,  1,1)  =’P"  THEN  MESS 

U04350 

CLOSE  WS 

004360 

MSG 2$  =  'CANCEL  Processing" 

004370 

MSK$=HEX(  00) 

004  380 

CMSGS  =  "  " 

004390 

CALL  "LINK*  ADDR( “DISPFILE" ,“p",RLIBS,RVULS,3*,PFILE$, 

004400 

SLIB$,SWLS,  *C*,MSG2$,  27*,  *H*,MSKS, CMSGS, 255%, C%,R%) 

004410 

F.RS  =  *  “ 

004420 

IF  C*OU  OR  R*<>0 

004430 

THEN  ERS  =  STR(CMSG$,  141) 

004440 

004450 

GOTO  CWMFVIU 

004460 

MESS: 

ERS  =  "  File  "t.PF!LESii‘  in  Liorary  "&  SLIBS  &"  on  * 

004470 

svors 

generated.* 

004480 

004490 

GOTO  BALONEY 

& 


004560  TTL_PGE: 

004570  CS-HEX( 8001 ) 

004580  WRITE  *2,  USI.'JG  TIT,  C$ 
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Page 


004590 


C$  =  HEX(0012) 


004600 

WRITE 

#2,  USING 

TIT,  i 

C$ 

004610 

C$  =  HEX(0001) 

004620 

WRITE 

#2,  USING 

mi. 

C$ 

004630 

WRITE 

#2,  USING 

TIT2, 

C$ 

004640 

WRITE 

#2,  USING 

TITO, 

c$,D$,r$ 

004650 

WRITE 

#2,  USING 

TIT3, 

c$ 

004660 

WRITE 

#2,  USING 

TIT2, 

c$ 

004670 

WRITE 

#2,  USING 

Till, 

c$ 

004680 

WRITE 

#2,  USING 

TIT2, 

c$ 

004690 

IP  S3TITLE$  =  " 

004700 

WRITE 

#2,  USING 

TIT4, 

c$, 

SB TITLES 

004710 

IF  S8TITL1$<»  " 

004720  TIT10, 

c$,  sstitli$ 

004730 

WRITE 

*2,  USING 

TIT2, 

G$ 

004740  GERRV: 

WRITE 

#2,  USING 

TITS, 

c$, 

FILES 

004750 

WRITE 

#2,  USING 

■riT2, 

c$ 

004760 

WRITE 

#2,  USING 

TIT6, 

c$. 

ILIBS 

004770 

WRITE 

#2,  USING 

TIT2, 

c$ 

004780 

WRITE 

#2,  USING 

TIT7, 

c$, 

IVOLS 

004790 

wr  vfs 

#2,  USING 

TIT2, 

c$ 

004800 

WRITE 

#2,  USING 

TIT8, 

c$. 

STARTPHS 

004810 

WRITE 

#2,  USING 

TIT2, 

c$ 

004620 

WRITE 

#2,  USING 

PI  T9, 

c$. 

ENDPHS 

004830 

FOR  1= 

=  1  TO  17 

THEN  GERR2 


THEN  WRITE  #2,  USING 


JM 


004840 

004850 


IP  TS(  I )  =“  X"  OR  f$(I)="*' 
NEXT  I 


THEN  PIRSTAT 


004660  FIRST AT:  WRITE  #2, USING  TTT2,C$;  WRITE  #2,USING  11111,0$, A$( 1} 


IP 


004870 
004880 
004890 
004900 
004910 
004920 
004930 

004940  HEADER 

004950 

004960 

004970 

004980 

004990 

005000 

005010  PRST1: 

005020 

005030 

005040 

005050 

005060 

005070  FIRST: 

005080 

005090 

005  LOO 

005110 

005120 

005130 

00514U  FOUr: 

005150 


FOR  K=  1+1  TO  17 
T$(K)="X"  OR  T$(  K) =*** 
NEXT  K 
WRITE  #2, 

WRITE  #2, 

RETURN 


THEN  WRITE  »2,  USING  TIT12,  C$,A$(K) 


USING  TIT2,  C$ 
USING  TIT1,  C$ 


IF  PAGE*=1  THEN  FIRST 
C$  =  KEX(OOOI) 

IF  STR(TP$,1,1)=*P"  THEN  FRST1 
WRITE  »2,  USING  TIT,  C$ 

WRITE  #2,  USING  IMG8,  C$ 

GOTO  FIRST 

IF  RTPLOO  THEN  FIRST 
WRITE  #2,  USING  RT,  HEX{0002) 

C$= HEX (0000) 

FOR  1=1  TO  2 

WRITE  #2,  USING  RTI ,  C$ 

NEXT  I 

C$  =  HEX( 8001 ) 

WRITE  #2,  USING  TIT,  C$ 

C$  =  HEX(OOOI) 

IF  S8TinE$  =  “ 

THEN  WRITE  #2,  USING  IMG, C$,J$,T$, PAGE* 

ELSE  GOTO  POUT 
GOTO  AIR  I  TE 

WRITE  #2,  USING  IMG! ,C$,SJTI  11>E$,D$,  1$, PAGE* 
IF  SBTU'LISO* 


Ub 
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005160 

005170 

005180 

005190 

005200 

005210 

005220 

005230 

005240 

005250 

005260 

005270 

005280 

005290 

005300 

005310 

005320 

005330 

005340 

005350 

005360 

005370 

005380 

005390 

005400 

005410 

005420 

005430 

005440 

005450 

005460 

005470 

005480 

005490 

005500 

005510 

005520 

005530 

005540 

005550 

005560 

005570 

005580 

005590 

005600 

005610 

005620 

005630 

005640 

005650 

005660 

005670 

005680 

005690 

005700 

005710 

005720 


THEN  WRITE  |2,  USING  IMG7,C$,SBTITL1$ 

ALRITE:  WRITE  #2,  USING  IMG2,  C$,  FILES,  ILIB$,  IVOLfc 
WRITE  #2,  USING  IMG3,  C$ 

WRITE  #2,  USING  IMG4,  C$ 

WRITE  #2,  USING  IMG5,  C$ 

WRITE  #2,  USING  IMG3,  C$ 

RETURN 

TIT0:%##  ####*#*» 

**#>*  : 

TIT:  %»* 

DG:%##  ill  END  OF  LISTING  111 

TIT1 : %  #  #  1 - 


TIT2: %## 

TIT3:%|» 

* 

TIT4  :%## 

tilt 

TIT5:%»» 

TIT6:%#I 
TIT7:%|# 

TIT8: %l I 

mi 

TIT9 :%## 

tm 

TIT10:%## 

li«l« 

TITll:%#l 

**#*#* 

TIT12:%»» 

*»**#* 

IMG:**#  «##««#»#  «##*# 

PAGE  tm* 

IMG1 :  %##  TITLE  OF  LIST  :  ######»#####»###»#**  #*#####» 

mi*  PAGE  *##** 

img7.-«»»  mmmimmmi 

IMG2:%I#  Input  File  is  #######•  in  Library  tttHHf  on  Volume  # # tf 

*»* 

I MG3:%#f =*==================— =================================== 


IMG4:%i»  WORD  Part  or  Past  To  1 

Be  Negative 

IMG5:%#t  Speech  Participle 

IMG6:%##  I  tlilhniMDIHilH  imilllll  I  #1 

* 

IMG9 : %  # I 

IMG8:%»#  +  =  ROOT  WORD 
KT:'*#I  BOLDFACE  =  Root  Word 
RT1 :%||  BOLDFACE 

/*  THIS  FUNCTION  PRINT,  OUT  ERROR  MESSAGES  AND  V 


******  OOMMON  WORD  LIST  **** 
TITLE  OF  LIST: 

INPUT  FILE: 

INPUT  LIBRARY :  *##t#t#» 

INPUT  VOLUME:  #*#*## 

STARTING  WORD: 

ENDING  WORD:  f #«*#«#*#*#**»»* 

############### 

ATTRIBUTES  SPECIFIED:  11111111* 

mimi# 
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0057 30  /*  SETS  OP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  */ 

005740  DEF  FN‘  7(MSG$,B$,C$,D4>) 

005750  PRINT 

005760  M$=HEX(94) 

005770  G£=B$ 

005780  U=C$ 

005790  V$=D$ 

005800  RETURN 
005810 

005820  EXIT:  CLOSE  #1 

005830  OUT:  /*  RETURNING  TO  COMMON  WORD  LIST  MENU  */  JM 


67 


CRES@SWL  in  library  CRES0PRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  Create/Maintain  Technical  Word  List  Subsystem. 

It  enables  the  user  to  select  by  PF  key  among  options  to  create/maintain  any 
technical  word  list,  to  print  a  technical  word  list,  to  print  a  technical  word 
list  by  attribute,  or  to  return  to  the  CRES  Master  Menu. 


A  complete  listing  follows. 
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PROCEDURE  CRES  SUPPLEMENTARY  WORD  LIST  MENU 
AUTHOR  ROSE  TANK 

DATE  10/07/83 

Abstract:  This  procedure  is  a  suos/stem  of  CRES  Master  Menu 
(option  2  -  Create/Maintain  Technical  Word 
Lists) . 

It  allows  the  user  to  select  and  run  any 
Technical  word  list  file  option. 


DECLARE 

DECLARE 

DECLARE 

DECLARE 

DECLARE 

DECLARE 

DECLARE 


&USERINPT  AS 
&OPTIONERR  AS 
&OPTIONERR2  AS 
S.USERNAME  AS 
&ERRMSG  AS 
&RUNLIB  AS 
&RJNVOL  AS 


INTEGER  INITIAL 
STRING  (79)  INITIAL 
STRING  (79)  INITIAL 
STRING  (24)  INITIAL 
STRING  (34)  INITIAL 
STRING  (8)  INITIAL 
STRING  (6)  INITIAL 


EXTRACT  r&USERNAME=USERNAME,  &RUNVOL=RUNVOL,  WUNLIBOUTLIfl 


GSTUSERINPT:  PROMPT  PFKEY  =  &USERINPT  CENTER 

DIM  "CRES:  Technical  Word  List  Subsystem 
1  Word  Menu  Screen)"; 


Rf 

RT 

RT 

RT 

RT 

r  Menu  RT 

RT 
RT 
RT 
RT 
RT 
RT 

"  RT 

*  RT 

*  RT 

"  RT 

"  JM 

*  JM 

RT 

UTLIfl  JM 

RT 
RT 

(Technica  RT 
RT 


000100 

000200 

000300 

000400 

000500 

000600 

000700 

000800 

000900 

001000 

001100 

001200 

001300 

001400 

001500 

001600 

001700 

001800 

001900 

002000 

002100 

002200 

002300 

002400 


— =  : 

DIM  "============-================== 

RT 

RT 

UU2SUU 

002800 

DIM  "  " 

,«  «  , 

•  i 

RT 

002700 

DIM  " 

Use  the  appropriate" , BRIGHT  " 

PF  Key*,"  to  select  the  desi 

RT 

002800 

red  operation 

m  # 

RT 

002900 

DIM  "  " 

,  ■  «  , 
r  i 

RT 

003U00 

DIM  " 

“ , LINE  "PF",DIM 

m  m 

/ 

RT 

UU3100 

LINE 

* 

Operation 

RT 

003200 

*  . 

0 

003300 

DIM  '  " 

;  , 

RT 

003400 

DIM  " 

",  Bright  "1"," 

-  Create/Maintain  Technical  w 

RT 

003500 

ord 

List" ; 

RT 

003600 

DIM  ' 

", aright  "2"," 

-  Print  Technical  Word  List"; 

RT 

003700 

DIM  " 

", aright  "3"," 

-  Print  Technical  Words  by  At 

RT 

003750 

tribute" ; 

003755 

DIM  "  " 

t 

RT 

003800 

DIM  * 

", aright  "16"," 

-  Return  to  CRES  Master  Menu" 

RT 

003900 

; 

DIM  "  " 

RT 

UU4000 

BRIGHT 

&OPIIONERR; 

RT 

004100 

BLINK 

{OPTION  ERR2; 

RT 

004200 

* 

RT 

UU430U 

ASSIGN  &ERRMSG  =  "  " 

RT 

0U4400 

ASSIGN  &OPTION ERR  =  "  " 

RT 

004500 

ASSIGN  SOPTIONERR2  =  "  " 

RT 

0U460U 

* 

RT 

004700 

IF 

MJSERINPT  EQ  16 

GOIU  USEREXIT 

RT 

0U48U0 

IF 

&USERINPT  EQ  32 

GOTO  USEREXIT 

Rf 

004900 

IF 

&USERINPT  EQ  1 

GOTO  RUN'IVJL 

RT 

005000 

IF 

&USERINPT  EQ  17 

GOIO  RUNTWL 

RT 

OUbOiO 

IF 

&USERINPT  EQ  2 

GOIO  RUNIWP 

Rf 

00510U 

IF 

6USERINPT  EQ  18 

GOIO  RJNTWP 

005110 

IF 

&USERINPT  EQ  3 

GOTO  RUNP8A 

Rf 

005120 

IF 

MJSERINPf  EQ  19 

GOIO  RUNP3A 

0051 30 

B 
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RT 

005200 

ASSIGN  &OPriONfiRR  = 

"I'm  sorry,  but  your  selected  option 

nr 

005300 

is  not  c 

urrently  avaiiaole.* 

RT 

005400 

ASSIGN  &OPITONERR2  = 

=  "Please  select  another  topic." 

RT 

005500 

GOTO  GETOS ERINPr 

RT 

005600 

* 

RT 

005700 

RUNTWL: 

RUN  CRES0IWL  IN  &RUNLIB 

ON  &RUNVOL 

Rr 

005800 

IF  RUNTWL  EQ  0 

GOIO  GETUSERINpr 

RT 

005900 

GOTO  USEREXIT 

RT 

006000 

* 

RT 

006100 

RUN1WP: 

RUN  CKES0TWP  IN  &RUNLIB 

S 

1 

c 

r 

RT 

006110 

IF  RUNTWP  EQ  0 

GOIO  GETUSERINPT 

RT 

006120 

GOIO  USEREXIT 

RT 

006130 

* 

RT 

006140 

RUNPBA : 

RUN  CRES@TPA  IN  WtUNLIB  ON  4.RUNVUL 

RT 

006150 

IF  RUNPBA  EQ  0 

GOTO  GETUSERINpr 

RT 

006160 

GOIO  USEREXIT 

RT 

006170 

* 

RT 

006180 

USER  EXIT: 

RETURN 

RT 

006200 

i 


n 
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CRES@TWL  in  library  CRES@SRC  is  the  BASIC  language  program  to 
create/maintain  the  technical  word  lists.  The  object  language  version  is 
CRESOTWL  in  library  CRES@SAV. 

The  Technical  Word  List  Subsystem  was  included  to  provide  for  the 
situation  where  there  is  a  body  of  technical  terminology  whicn  would  be 
considered  uncommon  in  normal  usage,  but  which  is  commonly  encountered  when 
discussing  a  particular  subject.  These  words  can  be  included  on  a  technical 
word  list  which  can  be  used  to  supplement  the  Common  Word  List  when  analyzing 
text  dealing  with  that  subject.  Any  words  found  on  the  specified  technical 
word  list(s)  will  be  considered  “common".  As  many  as  seven  technical  word 
lists  can  be  specified  for  inclusion  in  an  analysis. 

This  program  first  allows  the  user  to  specify  the  technical  word  list  to 
be  created  or  maintained.  The  program  then  enables  the  user  to  add,  delete, 
or  modify  any  given  word.  A  provision  is  made  for  clearing  the  protect  bytes, 
if  for  some  reason  those  bytes  have  been  left  set  incorrectly. 

The  only  characters  accepted  in  the  input  word  are  the  letters  A  through 

Z,  and  . .  There  can  be  no  embedded  blanks.  The  data  record  for 

each  word  contains  information  about  the  word's  attributes:  the  part  of 
speech  (see  Table  1),  the  past  participle  flag,  the  negative  flag,  the  form  of 
the  verb  "to  be"  flag,  and  the  root  word  flag.  A  complete  data  record 
description  is  provided  in  appendix  A. 

The  program  provides  for  a  protection  override.  A  protection  capability 
was  included  to  accommodate  multiple  users  on  the  system.  When  a  word  on  any 
of  the  CRES  word  lists  is  being  modified  by  one  user,  the  protection  bytes  for 
the  word  are  set  to  that  user's  ID.  No  other  user  can  access  that  word  while 
the  protection  bytes  are  set.  If  an  attempt  is  made  by  one  user  to  access  a 
word  protected  by  another  user,  a  message  specifying  the  user  and  workstation 
protecting  the  word  is  displayed.  When  the  word  is  released,  the  protection 
bytes  are  automatically  cleared.  To  provide  for  the  possibility  of  the  system 
going  down,  a  power  failure,  or  an  irregular  exit  leaving  a  word  with  its 
protection  bytes  still  set,  the  program  contains  a  protection  override 
capability.  For  a  given  user  to  override  the  protection,  either  the  word  had 
to  be  protected  under  that  user's  ID,  or  the  user  protecting  the  word  has  to 
be  no  longer  logged  on  to  the  computer. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart. 
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000010 

000020 

000030 

000040 

000050 

000060 

000070 

000080 


/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 


CRES  TECHNICAL  WORD  LIST  MAINTENANCE  SUBSYSTEM  PROGRAM 

AUTHORS:  Rose  Tank  and  John  Mears 
Date:  October  12,  1983 


This  program  was  developed  to  maintain  the  technical  word 
lists,  as  well  as  allow  for  the  creation  of  new  lists. 

It  is  designed  to  insert,  delete,  and  modify  any  word  in 
000090  /*  any  technical  word  list. 

000150  /*  Each  technical  word  list  is  similar  in  composition  to  the 
000160  /*  common  word  list.  This  subsystem  has  been  expanded  to 
000170  /*  handle  multiusers  by  use  of  protection  bytes  set  in  the 
000180  /*  record  of  the  word  to  be  modified.  There  is  an  override 
000190  /*  facility  available  within  the  program  itself  that  operates 
000200  /*  on  the  condition  that  the  user's  id,  which  is  extracted 


000210  /< 
000220  /* 
000230  /* 
000240  /* 
000250  /* 
000260  /* 


from  the  system,  matches  the  protection  bytes.  In  the  case 
where  the  user  attempts  to  modify  a  word  currently  con¬ 
trolled  by  another,  a  message  is  given  identifing  the  user 
and  his/her  location  -by  workstation  number. 

The  rec/ord  layout  for  the  technical  word  list  is  as  follows 


*/ 

*/ 

*/ 

*/ 

*/ 

*/ 

*/ 

V 
*/ 
*/ 
*/ 
*/ 
*/ 
*/ 

V 

V 
*/ 
*/ 
*/ 
*/ 

:*/ 


00  0420 
0004  3  0 
000440 
000450 
000460 
000470 
000480 
000490 
000500 
000510 
000520 
000530 
000540 
000550 
000560 
000570 
000580 
000590 
000600 
000610 
000620 


DIM  W0RD*20,ERR I J50.C0UE* 1 ,MSG*50,F*40,G*1 , PR0TECTJ3.WIDJ52 
DIM  F1J20, IOBUFF J40.ER 1 J50, XYZ*1 ,EXP*30,F2$10, NOE XI ST $66,  E*1 
DIM  PFK*4,TAB*3,BTAB*7,FILE*8,USERJ3,USERNAME*24,WRKST*3 
DIM  L IBJ8,F I L J19 , 1 V0L$6,PF$3,DEF$7 , A5$10,LEGJ5 , A7 $7 ,MES$G$2 1 
DIM  HEADER J50,L$1 , V$l ,8$1 ,C)I,D$1 ,MJ I ,M00$15,PFI6$4,ER$66 
DIM  ENTERJ5,PF)J3,P$( I3)3,PASSWRD$13,X$1 ,MESING$14 
DIM  PPARTFLJI  .ONEGFLJI  .MWLFLJl  .R00TFL&01 , TOBEFL $0 1 
DIM  PRT0FSPCS3 

ENTERJ="ENTER" 

PFIJ^'PFP:  PF  1 6$="PF  16" 

TA8J="TAB" 

BTA8$=“8ACKTAB" 

EXP$=" (Def i ni tion  of  Entries  Screen)" 

MESSG$="Parts  of  Speech  Codes" 

P$(  U  =  “(  J) " :  P$(2)  = "( j ) " :  P${3)  ="  (A) ":P}(4 )  ="  (a) ": P$( 5)  =  "(B )" 
P$(6)="(C) " :PS(7 )=" ( I) ":P$(8)="{N) ":PS(9)="(n)":P3( 10)="(P) " 
PJO 1 )  ="  (0)":P$(12)  ="(  V)  ":P$()3)="  (d) " 

II LE5J  ="PART  OF  SPEECH" 


RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

RT 

RT 

RT 


000270 

/* 

*/ 

RT 

000280 

/* 

character  position 

identifier 

variable  name 

*/ 

RT 

000290 

/* 

1-20 

==>  word 

WORDS 

*/ 

RT 

000300 

/* 

21 

=  -\ 

part  of  speech 

PRTOFSPCJ 

*/ 

RT 

000310 

/* 

22 

past  participle 

PPARTFL* 

*/ 

RT 

000320 

/* 

23 

==> 

negative 

NEGFL* 

*/ 

RT 

000330 

/* 

24 

=  => 

to  be  flag 

TOBEFL* 

*/ 

RT 

000340 

/* 

25 

==> 

f  i  Her 

*/ 

RT 

000350 

/* 

26 

=  => 

root  word 

ROOTFL* 

*/ 

RT 

000360 

/* 

27 

==v' 

Mandatory  tech. 

word  MWLFL? 

V 

RT 

000370 

/* 

29-31 

==> 

protection  byte 

PROTECT* 

*/ 

RT 

000380 

/* 

32-40 

==> 

filler  for  future  additions 

*/ 

RT 

000390 

/* 

*/ 

RT 

000400 

/* 

The 

words  are  stored 

in 

an  indexed  file 

with  the  key  bei  ng 

*/ 

JM 

000410 

/* 

the 

word  itself. 

*/ 

JM 

RT 

RT 

JM 

JM 

RT 

RT 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

JM 
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000630 
000640 
000650 
000660 
000670 
000680 
000690 
0007  00 
000710 
0007  20 
000730 
0  007  40 
0007  50 
0007  60 
0007  7  0 
000780 
000790 
000800 
000810 
000820 
000830 
000840 
000850 
000860 
00087  0 
000880 
000890 
000900 
000910 
000920 


000940 
000950 
0009  60 
000970 
000980 
000990 
001000 
001010 
001020 
001030 
001040 
001050 
001060 
001070 
001080 
00  1  090 
001  100 
(XI 1  1 1 0 
00 1 1 20 
001130 
001 140 
001 150 
001 160 
001  170 
001180 
00  I  190 


ITLE6S 


=  " OEF  INI T ION" 


/*  The  following  two  lines  are  used  as  formats  in  the  packing  */ 

/*  and  the  unpacking  of  record  field  values  */ 

F 1 $=HE  X ( AO  1 4A00 1  AO Cl AOO 1 A00 1 0001 A00 1 A001000 1 A0030009 ) 
F2$=HEX(001CA00  3  0009) 

/*  The  following  code  sets  up  a  screen,  which  asks  for  the  */ 
/*  name  of  the  file  containing  the  technical  word  list  that  is  */ 
/*  to  be  modified.  It  also  provides  the  opportunity  to  change  */ 
/*  the  library  and  volume  names  which  are  set  to  the  appro-  */ 
/*  priate  defaults  through  the  "Extract"  system  routine.  */ 

F$=  "FilenSne  not  found  on  ( 1  ibrary/vo  lume) .  “ 

ERR1S=  "I/O  ERROR  -  Please  specify  a  TECHNICAL  word  list" 

CALL  "EXTRACT"  A00R(  “ IL" .LIBS, "  IV", 1 VOLS  I D"  ,  USERS) 

AGAIN:  FILE  J>= "  “  :G$=HEX(81 ) 

MSG$=  "  "  :L$=HEX(81 ) 

V$=HEX(81 ) :  M$=HEX(8D) 

HEADERS  ="CRES  TECHNICAL  WORO  LIST  MAINTENANCE  SUBSYSTEM" 

FILS  '  “"Technical  Word  List” 

BLANKS:  FILES  =“  " 

FILMNU: 

ACCEPT 

AT  (01,01), 

"CRES:  Technical  Word  List  Maintenance  Subsystem", 

AT  (01,58), 

"(File  Selection  Screen)", 

AT  (02,01), 


AT  (04,10)! 

"Welcome  to  the", 

AT  (04,25)  ,  F AC ( HE X { 8 5)  )', 

HEADERS, 

AT  (07  ,07  ), 

"Please  specify  the", 

AT  (07  ,26),  FAC  ( H  EX  (84)  ) , 

FILS, 

AT  (07,46), 

"you  want  to  modify  or  create.", 

AT  (13,30), 

"File 

AT  (  13,43), FAC(GS)  .FILES  ,  CH(08 

RANGE  (  "1  "  ,  " UiUUUUt "), 

AT  (14,30), 

"Library  =", 

AT  ( 14,43)  ,FAC(  LS  ) ,  UBS  ,  CH(C 

RANGE  (  "I  "  ,  "UUUiiiiU"), 

AT  (15,30), 

"Volume  =", 

AT  (15,43) ,F AC( VS  ) .  I VOLS  ,  CH(C 

RANGE  (  " I  "  ,  "UUUUUtt"), 

AT  (18,24),  FAC(MS),  MSGS, 

AT  (20,30) ."Press", 

AI  (20,36) ,FAC(HEX(84)  ), 
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001  ZOO  ENTER} ,  1  RE 
001210  AT (20,42 ) ,  1  RT 
001220  “to  continue”,  !  RT 
001230  AT  (21, 15), "Press”,  1  RT 
001240  AT  (21,21),  FAC(HEX(84)) ,  I  RT 
001250  PF1  6$,  '.  RT 
001260  AT  (21,26),  !  RT 
001270  "to  return  to  the  Technical  Word  List  Menu",  1  RT 
001280  ON  (BIN( I6)&8IN(32 ) )  GOTO  OUT, OUT  RT 
001290  RT 
001300  MSG}=“  M}=HEX(8C)  RT 
001310  RT 
001320  /*  SET  UP  THE  USER  FILE  BLOCK  */  RT 
001330  RT 
00)340  SELECT  #  1 , "TECHWO",VARC ,  INDEXED, RE CSIZE*40,KEYP0S=)  ,KEYLEN=20,  I  RT 
001350  IOERR  GOTO  I0ERR1  RT 
001360  RT 
001370  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */  RT 
001380  /*  Y-  the  file  exists  fc  the  program  may  continue  */  RT 
001390  /*  N-  the  file  doesn't  currently  exist,  you  may  create  one  */  RT 
001400  /*  V-  the  Volume  supplied  doesn't  exist  or  is  not  mounted  */  RT 
001410  /*  L-  the  library  supplied  doesn't  exist  in  the  volume  given  */  RT 
001420  /*  E-  there  is  an  I/O  error  in  the  file  specified  */  RT 
001430  RT 
001440  CALL  "L  IMI  TS"(  FI LE},L IB} ,  I  VOL}  .CODE}, MSG} )  RT 
001450  IF  CODE}="Y"  THEN  RECCK  RT 
001460  IF  COOE}="N"  THEN  CREATE  RT 
00)470  IF  COOE}'"V"  THEN  GOSUB‘7 (STR(MSG},3) , HEX (81 ) , HEX (81 ) , HE X(9 1 ) )  RT 
001480  IF  CODE}="L"  THEN  G0SU8 '7  ( STR(MSG},3) , HE X ( 8 1 )  ,HEX(9 1 )  ,HEX(81 ) )  RT 
001490  IF  CODE}="E"  THEN  GOSUB' 7 ( STR(MSG},3) ,HEX(81 ) ,HEX(81 )  ,HEX(81 ) )  RT 
001500  GOTO  FILMNU  RT 
001510  RT 
001520  /*  The  following  screen  allows  the  user  to  create  an  additional  */  RT 
001530  /*  technical  word  list, or  respecify  the  file  information  entered*/  RT 
001540  CREATE:  -  RT 
001550  ACCEPT  I  RT 
001560  "CRES:  Technical  Word  List  Maintenance  Subsystem",  I  RT 
001570  AT  (01  ,53),  1  RT 
001580  "(Create  File  Option  Screen)",  I  RT 
001590  AT  (02,01),  I  RT 

001610  ===============",  ;  ri 

001620  AT  (06,08),  I  RT 
001630  "The  file  you  have  selected  does  not  currently  exist  in  the  libra!  RT 
001640  ry",  I  RT 
001650  AT  (07,08),  1  RT 
001660  "and  volume  specified.  For  your  convenience,  the  following  are  ",!  JM 
001670  AT  (08,08),  1  RT 
001680  "the  parameters  you  submitted:”,  !  JM 
001690  AT  (11,30),  !  RT 
001700  "File  1  RT 
001710  AT  (11,40) , FAC( HEX (85) )  ,F  ILE}  ,  CH(06),  '.  RT 
0017  20  AT  (12,30),  !  RT 
001730  "Li brary=" ,  !  RT 
001740  AT  (12,40),  FAC(HEX(65) ) ,  LIB}  ,  CH(OH) ,  !  RT 
001750  AT  (13,30),  !  RT 
001760  "Volume  =“,  !  RT 
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001770  AT  (13,40),  FAC  (HE  X(85 ) ) ,  IVOL?  ,  CH(06),  I  RT 

001780  AT  (17,15),  I  RT 

001790  "To  create  a  new  file  from  these  parameters,  press",  1  JM 

001800  AT  (17,65),  FAC(HEX(85)) ,  ENTER*  ,  CH(05),  1  RT 

001810  AT  (19,26),  I  RT 

00)820  "To  select  another  file,  press",  ; 

001830  AT  (19,56),  FAC(  HEX  (85 ) ) ,  PFI?  ,  CH(03),  1  RT 

001840  KE  YS(  B1  N(0)&BI  N(  1  )&81N  ( 17  ) )  ,KE  Y ( OPT  ION)  ,  1  RT 

001850  ON  ( B I N ( 1  )&B I N ( 1 7  ) )  GOTO  BLANKS, BLANKS  JM 

001860  RT 

00187  0  /*  Create  the  new  file  and  insert  a  header  record  to  identify  it*/  RT 
001880  OPEN  NOGETPARM  HI,  OUTPUT,  F I L E=  FILES,  LIBRARY=L  IB? ,  1  RT 

001890  VOLUME  =  IVOLJ,  SPACE=1000  RT 

001900  10BUFF J=  "  TECHNICAL  WORDS  “&  FILES  RT 

001910  WRITE  HI,  IOBUFFS  RT 

001920  CLOSE  HI  RT 

001930  GOTO  ZZ1  JM 

001940  RT 

001950  /*  Check  the  record  size  before  opening  the  file  to  avoid  */  JM 

001960  /*  accidently  causing  error  by  opening  a  file  with  incorrect  */  JM 
001961  /*  record'size.  */  JM 

001970  RECCK:  CALL  "READFDR"  ADDR( F I LE? , L  IB? ,  I  VOL?  ,0%,  "RS"  ,RSIZX,RET%)  RT 
001980  IF  RSIZXO40  THEN  112  JM 

00)990  IL\:  OPEN  NOGETPARM  HI, SHARED,  FILE=  FILE?,  LIBRARY  =  LIB?,  I  JM 

002000  VOLUME  =  I  VOL?  RT 

002010  RT 

002070  READ  HI,  10BUFF?  JM 

002080  IF  STR(  WHUFFS ,  1, 16)="  TECHNICAL  WORDS”  THEN  YES  RT 

002090  CLOSE  HI  JM 

002100  112:  M?=HEX(94 )  JM 

002110  MSG?=  ERRI?  RT 

002120  GOTO  FILMNU  RT 

002130  YES:  IOBUFF?="  "  RT 

002140  /*  This  section  of  code  generates  the  second  screen,  which  asks  */  RT 
002150  /*  for  the  particular  word  and -its  corresponding  operation  -  */  JM 

002160  /*  either  insert  word,  delete  word,  or  modify  word.  The  user  is  */  RT 
002170  /*  also  at  this  point  given  the  option  of  returning  to.  the  */  JM 
002180  /*  Technical  Word  List  Menu.  */  JM 

002190  RT 

002200  WID?="P lease  select  the  word:"  RT 

002210  WORD?, ER?,ER1?="  "  RT 

002220  WORDEQ?=  "word  =  "  R] 

002230  PFK?="  PF  "  RT 

002240  OPER?="  Operation"  RT 

002250  0?="  1"  :  T  ?=  "2" :  T  H?  =  "3"  :  ()?="  1 4" :  K?'"  1 5” : S?  =  " 1 6"  RT 

002260  NOEXIST?  =  "The  word  you  are  attempting  to  modify  does  not  exist"&  1  RT 
00227  0  "  in  this  list."  RT 

002280  X?=HEX(81 )  JM 

002290  E?=HEX (84)  RT 

002300  PASSWRD?=HEX(000102030EOF101 1 12I3IE1F20)  JM 

002310  RT 

002320  CWMENU:  RT 

002330  ACCEPT  ;  rt 

002340  AT  (01 ,01 ) ,"CRE5:  Technical  Word  List  Maint  Subsystem",  I  RT 

002350  AT  (01,49),  "(Word  &  Option  Selection  Screen)",  I  RT 

002360  AT  (02,01),  "======  =  =  ======*==  =  =====«================  =  :,  =  ===  \  RT 


002370  . . ;  RT 


/8 
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002380  AT  (04,08),  FAC(HEX(8C) ) ,  RT 

002390  WIOS,  1  RT 

002400  AT  (06,28),  FAC(HEX  (80),  1  RT 

002410  WORDEQS  ,  1  RT 

002420  AT  (06,36),  FAC(  X? ), WORDS  ,  CH(20),  1  JM 

002430  AT  (08,15),  FAC(  E$) ,  ER$,  1  JM 

00  24  40  AT  (09,23),  FAC  (  ES),  ER1} ,  1  RT 

002450  AT  (11,08),  "To  contl  RT 

002460  inue,  select  the  PF  key  corresponding  to  the  desired  operation.1',;  RT 
002470  AT  (13,30),  FAC(HEX(A5) ) ,  1  RT 

002480  PFK$  ,  I  RT 

002490  AT  (13,38),  FAC(HEX(AC) ),  RT 

002500  OP£R$ ,  l  RT 

002510  AT  (15,31),  FAC(HEX(84)) ,  I  RT 

002520  0$  ,  1  RT 

002530  AT  (15,39),  1  RT 

002540  "INSERT  word",  1  RT 

002550  AT  (16,31),  FAC(HEX(84)  ) ,  RT 

002560  TJ  ,  l  RT 

002570  AT  (16,39),  1  RT 

002580  “DELETE  v/ord",  1  RT 

002590  AT  (17,31),  FAC ( HEX(84) ) ,  1  RT 

00  2  600  THJ ,  1  RT 

002610  AT  (17,39),  ;  RT 

002620  "MODIFY  word",  1  RT 

002630  AT  (19,31),  FAC ( HEX(84)  ) ,  1  RT 

002  640  QS.  1  RT 

002650  AT  (19,39),  1  RT 

002660  "Protection  Override",  1  RT 

00  2670  AT  (20,31),  FAC(  HEX(84) ) ,  '.  RT 

002680  RS  ,  I  RT 

002690  AT  (20,39),  1  RT 

002700  "Return  to  Technical  Word  List  Selection",  I  RT 

002710  AT  (21,31),  FAC(  HEX(84) ) ,  1  RT 

0027  20  S$  ,  -  1  RT 

002730  AT  (21,39),  1  RT 

002740  "Return  to  Technical  Word  List  Menu",  1  RT 

002750  KEYS(PASSWROS) ,  I  JM 

002760  KEY(OPTION)  JM 

00277  1  IF  OP T ION=  1 5  OR  OPT  I0N=31  THEN  NEW  JM 

002772  IF  0PTI0N=I6  OR  0PTI0N=32  THEN  EXIT  JM 

002780  RT 

002790  FOR  1  =  1  TO  LEN(WOROJ) 

002800  IF  POS("  .'ABODE  FGIII JKLMNOPQRSTUVWX YZ-"=STR( WORDS, I , 1 ) )  =0  1  JM 

002810  THEN  ILLERR 

002820  NEXT  I 
002830 

002840  ES-  HEX(RO)  RT 

002850  ERS  ,E R 1 S= "  "  RT 

002860  /*  Check  for  confirmation  of  deletion  */  RT 

002870  IF  ( OPT I0N=0)AND ( DF  =  1 )  THEN  DEL  RT 

002880  /*  Check  for  cancellation  of  deletion  */  JM 

002890  IF  DF= I  THEN  UPDATE  RT 

002900  /*  Check  for  override  of  protection  byte  */  RT 

002910  IF  (OPTION^  14)  OR  (0PTI0N=30)  THEN  OVERRIDE  RT 

002920  IF  STR(WORDS,  1,1)0"  "  THEN  REED  RT 

00  29  3  0  RT 
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002940  PRINT  BELL  RT 

002950  ERS="  The  first  character  cannot  be  blank." 

0029  60  ER1  S=  "Please  reenter  the  appropriate  word  and  PF  key."  RT 

002970  £$=  HEX  (94)  RT 

002980  60T0  CWMENU  RT 

002990  RT 

003000  ILLERR: 

003010  ER$="I1  legal  character  found  in  word  -  please  reenter." 

003020  E$=HEX(94) :  GOTO  CWMENU  RT 

003030 

003040  OVERRIDE:  RT 

003050  IF  NF= 1  AND  PX*1  THEN  CHK  RT 

003060  ER$=  "Please  check  if  word  exists  by  selecting  an  option."  RT 

003070  E$=H£X(84 )  RT 

003080  GOTO  CWMENU  RT 

003090  RT 

003100  /*  Protection  override  is  confirmed  if  the  protection  was  set  */  RT 

003110  /*  by  a  user  not  currently  logged  on  or  if  the  current  user's  */  RT 

003120  /*  id  equals  the  protection  bytes.  */  JM 

003130  CHK:  RT 

003140  IF  (US£R$-PR0TECT$)  OR  (WRKSTX=-I)  THEN  REMOVE  RT 

003150  ER$=  "You  don't  have  the  clearance  to  override  the  protect."  RT 

003160  ER1$-"  "  RT 

003170  E$=  HEX(84)  RT 

003180  GOTO  CWMENU  RT 

003190  RT 

003200  /*  Reset  the  protection  bytes  to  blanks  */  JM 

0032 1C  REMOVE:  PR0TECT$=  "  ":P*=0  RT 

003220  READ  # 1 ,  HOLD,  KEY=W0R0$, IOBUFFJ  RT 

003230  JPACK  (F  =  F  1 J)  I08UFFJ  FROM  W0RC>,  PRTOFSPCJ,  PPARTFL5,  I  RT 

003240  DNEGFLJ,TOBEFL$,ROOTFLJ,MWLFL$,  PROTECT?  RT 

003250  REWRITE  H 1 ,  IOBUFFJ,  DATA  GOTO  I0ERR2  RT 

003  2  60  ERf=  "  You  may  now  select  your  option."  RT 

00327  0  ER1J=  "  "  RT 

003280  E$=  HEX(84)  RT 

003290  GOTO  CWMENU  RT 

003300  RT 

003310  I0ERR1:  PRINT  RT 

003320  M$=HE  X(94 )  RT 

003330  MSG*=  EKR1 $  RT 

003340  CLOSE  01  RT 

003350  GOTO  FILMNU  RT 

003360  RT 

003370  I0ERR2:  PRINT  RT 

003380  PRINT  HE X (9 4 ) , "Error  occurred  on  file  FILE$  RT 

003390  PRINT  HEX(94) , "Error  code  =  FS(01)  RT 

003400  STOP  "Touch  ENTER  to  return  to  menu."  RT 

003410  GOTO  CWMENU  RT 

003420  RT 

003430  /*  Error  message  is  printed  if  "ENTER"  was  hit  before  the  option*/  RT 

003440  /*  was  entered  */  RT 

003450  REED:  IF  OPTIONOO  THEN  SRCH  RT 

003460  ERJ=  "Operation  missing  -  Please  select  a  PF  key."  JM 

003470  E$=  HE X(94 )  RT 

003480  GOTO  CWMENU  RT 

003490  RT 

003500  SRCH:  P%=!  RT 


80 
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003510  READ  4  1 ,H0L0,KEY=W0RD?, IOBUFF?, EOD  GOTO  NOTFOUND,  1  RT 
003520  OATA  GOTO  I0ERR2  RT 
003530  RT 
003540  N F=  1  /*  The  word  was  found  */  RT 
003550  RT 
003560  /*  Unpack  and  check  if  currently  being  modified  by  another  */  RT 
003570  RT 
003580  ?UNPACK  (F=Fi?)  IOBUFF?  TO  WORD?, PRTOFSPC?, PPARTFL?,  I  RT 
003590  ONEGFL?,  TOBEFL?, ROOTFL?,  MWLFL?,  PROTECT?  RT 
00  3600  IF  PROTECT?1  "  “  THEN  NOW  RT 
003610  CALL  "FINDUSER"  ADDR (PROTECT?, USERNAME?, WRKSTS)  RT 
003620  CONVERT  WRKSTX  TO  WIKST?,  PIC(###)  RT 
003630  E?=  HEX(94 )  RT 
003640  ER?="  Sorry,  "&  USERNAME?  4"  is  currently  editing  "  RT 
003650  ER1?="  WORD?  &  &  “  at  workstation  "&  WRKST?  RT 
003660  REWRITE  41, 108UFF?  RT 
003670  GOTO  CRMENU  RT 
003680  RT 
003  690  /*  Set  the  protection  bytes  */  JM 
003700  NOW:  PROTECT?;  USER?  RT 
003710  '?PACK  (F=F1?)  IOBUFF?  FROM  WORD?,  PRTOFSPC?,  PPARIFL? ,  1  RT 
003720  DNEGFL?,TOBEFL?,ROOTFL?,MWLFLS,  PROTECT?  RT 
003730  REWRITE  #1,  IOBUFF?,  DATA  GOTO  10ERR2  RT 
003740  RT 
0037  50  /*  NOW  BRANCH  TO  THE  OPTION  SELECTED  */  RT 
003760  OPT:  ON  OPTION  GOTO  INSERT, OELET.MODIFY  RT 
0037  7  0  ON  OPTION-16  GOTO  INSERT, OELET.MODIFY  RT 
003780  RT 
003790  NOTFOUND:  NF=0  /*  The  word  was  not  found  in  the  list  */  RT 
003800  GOTO  OPT  RT 
003810  RT 
003820  INSERT:  RT 
003830  /*  NF=0  indicates  the  word  doesn't  yet  exist  so  go  ahead  */  RT 
003840  /*  and  insert.  NF = 1  indicates  the  word  exists.  */  RT 
003850  -  RT 
003860  IF  IF  =  1  THEN  EXIST  RT 
003870  MOD?=  "(Insert  Screen)"  RT 
00387  1  MESING?="lnsert1ng  word"  JM 
003880  MWLFL?, PPARTFL?, PRTOFSPC?, DNEGFL?,HU0IFL?,  IUBEFL?  ="  "  RT 
003890  IOBUF F?="  ":  PROTECT?=  USER?  RT 
003900  ?PACK  (F=F1?)  IOBUFF?  FROM  WORD?,  PRTOFSPC?,  PPARTFL?,  I  RT 
0039  1  0  ONEGFL?,TOBEFL?,ROOTFL?, MWLFL?, PROTECT?  RT 
003920  WRITE  #1,  IOBUFF?,  DATA  GOTO  I0ERR2  RT 
0039  30  GOTO  INS  RT 
003940  RT 
003950  /*  Coming  from  insert  with  the  word  currently  existing,  */  RT 
003960  /*  print  an  error  message  and  erase  the  protection  byte  */  RT 
003970  EXIST:  RT 
003980  ER?=  "The  word  ,M  &  WORD?  &  already  exists  in  this  list."  RT 
003990  E?=  HEX(94)  RT 
004000  READ  41,  HOLD,  KEY=  WORD? ,  IOBUFF  ?  RT 
004010  PROTECT?^"  "  :P%=0  RT 
004020  ?PACK  (F=F 1 ? )  I08UFF?  FROM  WORD?,  PRTOFSPC?,  PPARTFL?,  I  RT 
004030  DNEGFL?,T08EFL?,R00TFL?,MWLFL?,  PROTECT?  RT 
004040  REWRITE  41,  IOBUFF?,  DATA  GOTO  I0ERR2  RT 
004  0  50  GOTO  CWENU  RT 
004060  RT 
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00  4070  /*  DELET,DEL,N00£1-  all  pertain  to  the  delete  option  */  RT 

004080  /*  OELET -  gives  the  user  a  chance  to  cancel  the  deletion  */  RT 

004090  DELET:  IF  NF=0  THEN  NODEL  RT 

004100  DF= 1  RT 

004110  ER}  =  "  Press  ENTER  to  confirm  deletion  of  "&  WORDS  RT 

004120  ER1$="  or  press  PF14  to  cancel  deletion."  JM 

004130  PASSWRD£=HEX(OOOE1E )  JM 

004140  X$=HEX(84 )  JM 

004150  E$=  HEX  (94)  RT 

004160  GOTO  CVWENU  RT 

004170  RT 

004180  /*  DEL-  deletes  the  entire  record  */  RT 

004190  DEL:  READ  #1 ,  HOLD, KEY=WORO$,  IOBUFFJ  RT 

004200  DELETE  #1  RT 

004210  DF=0  RT 

004220  ERS=  “  '  "&WORD$&1''  deleted  -  Please  select  your  next  word."  RT 

004  2  30  WID$="  Updating  "&FILES&"  Technical  Word  List" 

004240  EJ-  HEX(dC)  RT 

004250  WORD "  "  RT 

004260  NF=0  JM 

004270  PASSWRDJ=HEX(000102030E0F101  112131E1F20)  JM 

004280  XJ=HEX(81)  JM 

004290  GOTO  CWMENU  RT 

004  300  RT 

004310  /*  NODEL-  print  an  error  message  when  the  word  doesn't  exist  */  RT 

004320  NODEL:  ER$=  "The  word  ‘ "&  WORDS  &  does  not  exist  in  this  list."  RT 
004  330  ES=  HE  X  ( 9  4 )  RT 

004340  GOTO  CFMENU  RT 

004350  RT 

004360  MODIFY:  IF  NF  =  1  THEN  GETIT  RT 

004370  ERJ  =  NOEXISTS  /*  if  word  not  in  list,  */  RT 

004380  E HE X (9 4 )  /*  set  up  message  and  fac  and  */  RT 

004390  GOTO  CWMENU  /*  go  back  up  to  previous  screen  */  RT 

004400  RT 

004410  GEIIT:  .  JM 

004440  MODS  =" (Modify  Screen)"  RT 

004441  ME  SINGS- "modi  tying  word"  JM 

004450  INS:  RT 

004460  PF S  ="PF1 "  RT 

0  04  4  7  0  OEFS  ="CUKRENT"  RT 

004480  A5S  -"ATTRIBUTES"  RT 

004440  LEGS  '-"LEGAL"  RT 

004  500  A7S  -"ENTRIES"  RT 

004510  ER I S  =“  "  RT 

004  5  20  XY2$  -HE  X(8C)  RT 

004530  RT 


004540  /*  This  accept  statement  generates  a  screen  with  the  attributes  */  RT 
004550  /*  corresponding  to  each  word  appropriately  labeled  for  insert  */  RT 
004560  /*  or  modification.  It  also  calls  a  second  screen  on  request  if  */  RT 
004570  /*  there  is  a  need  for  an  explanation  of  the  legal  entries  for  */  RT 


004580  /*  the  parts  of  speech.  */  JM 
004590  RT 
004600  A  OK  :  RT 
004610  RT 
004620  ACCFPT  ;  RT 
004630  AT  (01,01),  I  RT 
0CT640  "CPFS:  Technical  Word  List  Maintenance  Subsystem",  !  RT 


Wang  VS 
Input  F 

004650 
004660 
00467  0 
004680 
004600 
004700 
004710 
0047  20 
004730 
004740 
0047  50 
0047  60 
00477  0 
0047  80 
004790 
004800 
004810 
004820 
004830 
004840 
004850 
004860 
00487  0 
004880 
004890 
004900 
004910 
00  49  20 
004930 
004940 
004950 
004960 
00497  0 
004980 
004990 
005000 
005010 
G05020 
005030 
005040 
005050 
005060 
00507  0 
005080 
00  5090 
005100 
005110 
005120 
005130 
005140 
005150 
005 1 60 
005170 
005180 
005190 
005200 
005210 
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AT  (01,66),  FAC(HEX(8C)),M0D}, 
AT  (02,01),  "====*============ 


AT  (03,07), 

'‘For  an  explanation  of  legal  entries,  press", 

AT  (03, 50), FAC (HEX (84)) ,  PF}  , 

AT  (03,54), 
otherwise,  enter", 

AT  (04,07), 

“the  appropriate  attri bute(s ) . ", 

AT  (06,33) ,FAC(HEX(AD) ) ,  DEF}  , 

AT  (06,41 ) , FAC ( HE X( AO ) )  ,  A5}  , 

AT  (06.58) ,FAC(HEX(AD) ) ,  LEG}  , 

AT  (06,64) ,FAC(HEX( AD) ) ,  A7J  , 

AT  (08,07), 

"WORD  i 11 

AT  (08,15) ,FAC(H£X(84) ) ,  WORD}, 

RANGE  (  "1  “  ,  "UiUUlU <<T). 

AT  (08,61), 

“(A-Z.-1 )“, 

AT  (10,07), 

PART  OF  SPEECH:", 

AT  ( 10,41 ) ,FAC(H£X(80) ) .PRTOFSPC},  CH(01), 
AT  (10,57), 

(ABCI JNOPVad jn)  " , 

AT  (11,07), 

PAST  PARTICIPLE:", 


AT  (11,41),  PPARTF LJ 

AT  (11,57), 

'(*  or  NO  ENTRY)", 

AT  (12,07), 

'NEGATIVE:", 

,  CH(OI), 

AT  (12,4  1),  DNEGFL} 

AT  (12,57), 

'(*  or  NO  ENTRY)", 

AT  (13,07), 

'TO  BE:", 

,  CH(01), 

AT  (13,41),  T08EFL} 

AT  (13,57), 

'(*  or  NO  ENTRY)", 

AT  (14,07), 

'MANDATORY  TECHNICAL  WORD:", 

,  CH(01), 

AT  (14,41),  MWLFL} 

.  CH(01), 

AT  (14,57), 

'(*  or  NO  ENTRY)", 

AT  (15,07), 

'ROOT  WORD:", 

AT  (15,41),  ROOTFL},  CH(01), 

AT  (15,57), 

'(*  or  NO  ENTRY)", 

AT  (  17,25), FAC(XYZ}),ER1}, 

AT  (20,  17  ) ,  "Use",  FAC  (HEX  (8  5) ) ,  TAB},  "or",  FAC  (HEX  (85) ) , 
BTAB},"to  move  between  modifiable  fields.", 

AT  (23,30), 

'Press", 

AT  (23,36) , FAC (HEX (84) ) .ENTER}, 

AT  (23,42), 


RT 

RT 

RT 

RT 

JM 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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005220 
005230 
005240 
0052  50 
005251 
005260 
005270 
005280 
005310 
005320 
005330 
005340 
005350 
005360 
005370 
005380 
005390 
005400 
005410 
005420 
005430 
005440 
005450 
005460 
00547 0 
005480 
005490 
005500 
005510 
005560 
005570 
005580 
005  590 
005600 
005610 
005620 
005630 
005640 
005650 
0  0  5  660 
005670 
005680 
005  690 
0057  00 
005710 
0057  20 
005730 
00  57  40 
0057  50 
0057  60 
005770 
005780 
005790 
005800 
005810 
005820 
005830 


"to  continue", 

AT  (24,21), 

"Press"  , AT (24, 27 ) , FAC (HEX (84) ),  PFI6J  ,AT(24,32), 

"to  exit  without  ", 

AT  (24,48),  FAC ( HE X (8C ) ) ,  MESINGJ, 
KEYS(BIN(0)&BIN(1)&BIN(17)&BIN(16)&BIN(32))  ,KE  Y( OPTION ) , 

ON  ( BI N( 1 6 )&BI N(32 ) )  GOTO  EXIOM, EXIOM 

IF  OPTIONS  OR  OP T 10 N=  1 7  THEN  OEFIN 

/*  Check  for  validity  of  entries  */ 

IF  POS("A8CIJNOPVadjn"=PRTOFSPC$)>0  THEN  NEXT1 
ER1J  =  "Part  of  Speech  value  is  illegal." 

XYZJ  =  HEX  (94 ) 

GOTO  AOK 

NEXT1 :  IF  P0S("  *"=PPARTFLJ)>0  THEN  NEXT2 

ER1J  =  "Past  Participle  value  is  illegal." 

XYZJ  =  HEX  (94) 

'GOTO  AOK 

NEXT2:  IF  POS("  *"=DNEGFLJ)>0  THEN  NEXT3 

ER1J  =  "  Negative  value  is  illegal." 

XYZJ  =  HEX(94) 

GOTO  AOK 

NEXT 3:  IF  POS(  "  *"=TOBEFLJ )>0  THEN  NEXT4 

ERIJ  =  "  To  Be  value  is  illegal." 

XYZJ  =  HEX  (94 ) 

GOTO  AOK 

NEXT4 :  IF  POS("  *"=MWLFLJ)?0  THEN  NEXT5 

ERIJ  =  "Mandatory  word  value  is  illegal." 

XYZJ  =  HEX  (94) 

GOTO  AOK 

NEXT5:  IF  POS("  *"=R00TFLJ)>0  THEN  UPDATE 

ER1J  =  "  Root  word  v«alue  is  Illegal." 

XYZJ  =  HE  X(94 ) 

GOTO  AOK 

/*  EXIOM  is  used  to  abnormally  exit  the  insert  mode  and  */ 

/*  NOCHAN  is  used  to  abnormally  exit  the  modify  mode  */ 

EXIOM:  READ  #1,  HOLD, KEY=WORDJ,  IOBUFFJ 
IF  NF= 1  THEN  NOCHAN 
DELETE  #1 

ERJ=  "  Word  "&WORDJ&"  was  not  inserted." 

GOTO  CWi ENU 

NOCHAN:  PROTEC TJ  =  "  "  :PX=0 

JPACK  (F  =F2 J )  IOBUFFJ  FROM  PROTECTJ 
REWRITE  *  I , IOBUFFJ .DATA  GOTO  I0ERR2 
ERJ=  "  No  changes  were  saved." 

ER1J="  " 

GOTO  CWMENU 

/*  UPDATE  removes  the  protection  on  the  record  and  writes  out  */ 
/*  the  final  data  as  inputted.  */ 

UPDATE:  READ  XI,  HOLD,  KEY=WORDJ,  IOBUFFJ 
PROTECTJ  =  "  "  : PX=0 
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005840  JPACK  (F=F)$)  IOBUFFJ  FROM  WORDJ.PRTOFSPCS.PPARTFLJ,  1  RT 
005850  DNEGFL$  ,T0BEFL$, ROOT FL$,MWLFL$, PROTECTS  RT 
005860  REWRITE  #1 ,  I08UFFJ.DATA  GOTO  I0ERR2  RT 
00587  0  ER IJ*  “  " 

005880  IF  NF=0  THEN  RITE  /*  NF*0  indicates  insert  mode  */  RT 
005890  IF  OF  =  1  THEN  EXOEL  /*  OF  =  1  indicates  delete  mode  */  RT 
005900  WIO$="  Updating  "&FILEJ&"  Technical  Word  List"  JM 
005910  ER$=“  '"&WOfiD$&“'  updated  -  Please  select  next  word."  JM 
005920  EJ=HEX(8C)  RT 
005930  WORD}*"  “  RT 
005940  GOTO  CWMENU  RT 
0059  50  RITE:  RT 
005960  ER$*  "  '"iiWORDJIi"1  inserted  -  Please  select  your  next  word."  RT 
00597  0  WIO$=“  Updating  “8.FILES&"  Technical  Word  List"  JM 
005980  EJ-  HEX(8C)  RT 
005990  W0RD$="  "  RT 
006000  GOTO  CWENU  RT 
006010  RT 
006020  EXOEL:  DF=0  RT 
006030  ERS  =  B  Deletion  cancelled."  RT 
006040  P/<SSWRD$=HEX(000102030£OF101 11213IE 1F20)  JM 
006050  XJ=HEX(81)  JM 
006060  GOTO  CVWENU  RT 
006070  RT 
006080  NEW:  PRINT  PAGE,  AT( 12.28) ,HEX(84) ; "Clos ing  last  file"  RT 
006090  FOR  1=  1  TO  50000:NEXT  I  RT 
006100  CLOSE  #1  RT 
006110  GOTO  AGAIN  RT 
006120  RT 
006130  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */  RT 
006140  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  */  RT 
006150  DEF  FN'7(MSG$,BS,CS,D$)  RT 
006160  PRINT  RT 
006170  MS=HEX(94)  RT 
006180  GS=BS  '  RT 
006190  LS=CS  RT 
006200  V$=D$  RT 
006210  RETURN  RT 
006220  RT 
006230  OEFIN:  RT 
006240  ACCEPT  [ 


006250  AT  (01,01), 

006260  "CRES:  Technical  Word  List  Maintenance  Subsystem", 

006270  AT  (01,51),  FAC(HEX(8C) ) , 

006280  EXPJ, 

006290  AT  (02,01 ) , "=======*====================================«= 

006300  ==============*:====«***===.=**=====«, 

006310  AT  (05,08),  FAC ( HE X( AD ) ) ,  ITLE5$  ,  CH(14), 

006320  AT  (05,49),  FAC(HEX(AO) ) ,  ITLE6$  ,  CH(10), 

006330  AT  07  ,03),  FAC(HEX(84)) ,  P*(l)  ,  CH (03) , 

006340  AT  (07  ,08), 

006350  "Adjective  . Modifies  a  noun  or  pronoun", 

006360  AT  (08,03),  FAC(HEX(84) ) ,  PJ(2)  ,  CH(03), 

006370  AT  (08,08), 

006380  "Adjective/verb  . A  word  that  may  function  as  an  adjective 

006390  or  verb", 

006400  AT  (09,03),  FAC(HEX(84) ) ,  P*(3)  ,  CH(03), 


JM 

JM 

JM 
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006410  AT  (09,08), 

006420  "Adverb  . Modifies  a  verb,  adjective,  or  adverb", 

006430  AT  (10,03),  FAC ( HEX ( 84 } ) ,  P$(4)  ,  CH(03), 

006440  AT  (10,08), 

006450  "Adverb/verb  . A  word  that  may  function  as  an  adverb  or 

006460  verb", 

006470  AT  (11,03).  FAC(HEX(84)),  P$(5)  ,  CH(03), 

006480  AT  (11,08), 

006490  "Article  . A  limiting  adjective  before  a  noun  (e.g. 

006500  a,  the)", 

006510  AT  (12,03),  FAC(HEX(84) ) ,  P3 (6)  ,  CH(03), 

00  6520  AT  (12,08), 

006530  "Conjunction  . Links  phrases  or  clauses  (e.g.  or)", 

006540  AT  (13,03),  FAC (HEX(84) ) .  PJ(7)  ,  CH(03), 

006550  AT  (13,08), 

006560  "Interjection  . Used  for  simple  exclamations  (e.g.  Ohl)" 

00657  0  , 

006580  AT  (14,03),  FAC(HEX(84) ) ,  P$(8)  ,  CH(03), 

006590  AT  (14,08), 

006600  "Noun  . Indicates  a  person,  place,  or  thing", 

006610  At  (15,03),  FAC(HEX(84) ) ,  P$( 13)  ,  CH(03), 

00662  0  AT  (15,08), 

006630  "Noun/ad)ective  . A  word  that  may  function  as  a  noun  or  ad 

006640  jective" , 

006650  AT  (16,03),  FAC(HE X(84 ) ),  PJ(9)  ,  CH(03), 

006660  AT  (16,08), 

006670  "Noun/verb  . Word  that  may  function  as  a  noun  or  verb 

006680  ", 

006690  AT  (17,03),  FAC(  HEX(84) ) ,  P$(10)  ,  CH(03), 

006700  AT  (17,08), 

006710  "Preposition  . Expresses  a  relationship  between  two  ele 

0067  20  ments  of  " , 

00  67  30  AT  (18,08), 

006740  "  a  sentence  (e.g.  in,  on,  by,  to,  since) 

006750  ", 

006760  AT  (19,03),  FAC(HEX(84 ) ) ,  P*(ll)  ,  CH(03), 

006770  AT  (19,08), 

0067  80  "Pronoun  . Word  that  may  be  used  as  a  substitute  fo 

006790  r  a  noun", 

006800  AT  (20,08), 

006810  "  (e.g.  I,  you,  she,  what,....)", 

0068  20  AT  (21,03),  FAC(HEX(84) ),  PJ(12)  ,CH(03), 

00  68  30  AT  (21,08), 

U06840  "Verb  . Oenotes  an  action  or  occurrence", 

006850  AT  (23,20), 

006860  "Press", 

006870  AT  (23,26),  FAC(HEX(84 ) ) ,  PF1J  ,  CH(03), 

006880  AT  (23,30), 

006890  "to  return  to  the  previous  screen", 

00  6900  KE YS(BIN(  1  )tBIN{  17  ) ) ,  ON  (BIN(  1  }&BIN(  17  ) )  GOTO  AOK.AOK 
00  69  10  EXIT:  CLOSE  *1 

00  6920  OUT:  /*  RETURNING  TO  TECHNICAL  WORD  LIST  MENU  */ 
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Print  Technical  Word  List  (CRES0TWP) 

CRES@TWP  in  library  CRES@SRC  is  the  BASIC  language  program  to  print  the 
technical  word  lists.  The  object  language  version  is  CRES@TWP  in  library 
CRES@SAV. 

This  program  first  allows  the  user  to  specify  the  technical  word  list  to 
be  printed.  Then,  the  program  enables  the  user  to  print  out  either  the  entire 
technical  word  list,  or  a  specified  portion.  This  printout  can  be  displayed 
at  the  terminal  or  sent  to  the  printer.  An  optional  subtitle  of  up  to  two 
lines  can  be  included  for  the  printout,  and  the  number  of  lines  per  page  may 
be  specified  as  some  value  less  than  the  default  of  50. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart. 


Technics 


THIS  PAGE  INTENTI 


Technical  Report  86-001 


Wang  VS  Integrated  Editor  -  Version  6.10.00  11:37  11/09/84  Page 

Input  File  is  CRES@IWP  in  Library  CRES@SRC  on  Volume  CRES02 

0000 10  /*  This  is  the  CRES  TECHNICAL  WORD  LIST  PRINT  SUBSYSTEM  PROGRAM  */  JM 
000035  /*  */  RT 

000060  /*  AUTHORS:  Rose  Tank  and  John  Meats  */  RT 

000085  /*  Date:  Octooer  12,  1983  */  RT 

000110  /*  */  RT 

000135  RT 

000160  /*  The  following  code  sets  up  a  screen,  which  asus  for  the  */  RT 

000185  /*  name  of  the  file  containing  the  technical  word  list  */  RT 

000210  /*  to  be  printed.  It  also  provides  tie  opportunity  to  change  */  RT 

000235  /*  the  library  and  volume  names  which  are  set  to  the  appro-  */  RT 

000260  /*  priate  defaults  through  the  'Extract*  system  routine.  */  rt 

000285  RT 

000310  RT 

000335  DIM  WORD$24,OOD£$i,MSG$50,F$40,G$l,CMSG$255,MSG2$40  RT 

000360  DIM  IOBUFF$;64,EXP$31,PFIL£$Oa,RVOL$Oo,PFl$3,RLia$8  JM 

000385  DIM  TAB$3,BTAB$7,FILE$08,LI8$08,FIL$19,SVOL$6,SLI8$8  JM 

000410  DIM  IVOL$06,HEAD£R$51,L$1,V$1,B$1,C$2,D$8,M$1,MSK$2  RT 

000435  DIM  SaTITLE$20,A$(14)10,SBTITLl$20,E2i41  JM 

000460  DIM  ENTERS  05  RT 

000485  DIM  PF16$  ,  04  RT 

000510  DIM  £Ri>  79,MESSG$21  RT 

000535  DIM  STARTPH$  20  RT 

000560  DIM  ENDPil$  20  RT 

000585  DIM  TP$  08  RT 

000610  DIM  PF15S  04  RT 

000660  A$(l)=*  "adjective*  RT 

000685  Af(2)=  "verb*  RT 

000710  A$( 3) =  "conjugate"  RT 

000735  A${  4)  =>  "adjec/verb*  RT 

000760  A$(5)=  "noun*  RT 

000785  A$(6)=  "pronoun*  RT 

000810  A$(7)=  "interject"  rt 

000835  A$(8)=»  "noun/ verb"  RT 

000860  A$(9)=  "adverb"  ,  rt 

000885  A$( 10) ="preposit"  '  RT 

000910  A$( lll="article"  RT 

000935  A£( 12) “"adv/ verb"  RT 

000960  A$(13)="noun/adj"  RT 

000985  TAB$=" TAB"  RT 

001010  BTAB$=" BACK TAD"  RT 

001035  EXP$="( Explanation  of  Entries  Screen)"  RT 

001060  MESSG$="Parts  of  Speech  Codes"  RT 

001065  ENTEK$=" ENTER’  RT 

001085  P$=  "Filename  not  found  on  ( library/ volume) RT 
001090  E2$="  Please  specify  a  TECHNICAL  word  list."  JM 

001110  CALL  "EXTRACT"  ADDR(  "  IV",  IVOLS,  *RV",RV0LS,  ’  IL"  ,LIB$,  "RL"  ,RLIB$,  1  JM 
001135  "SL",SLIB$,"SV",SVOL$)  JM 

001160  AGAIN:  FILE$=*  " :G$=HEX( 81)  RT 

001185  MSG$="  "  :L$=HEX(81)  RT 

001210  V$=HEX(81) :  M$=HEX(8D)  RT 

001235  HEADERS  ="CRES  TECHNICAL  WORD  LIST  PRINT  SUBSYSTEM"  RT 

001260  FILS  ="Technical  Word  List"  JM 

001310  PF1$="PF1":PF16$-"PF16"  RT 

001335  RT 

001360  /*  Print  the  first  screen  at  the  terminal.  V 
001385 

001410  FILMNU:  RT 
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001435 

001460 

001485 

001510 

001535 

001560 

001585 

001610 

001635 

001660 

001685 

001710 

001735 

001760 

001785 

001810 

001835 

001860 

002085 

002110 

002135 

002160 

002185 

002210 

002235 

002260 

002285 

002310 

002335 

002360 

002385 

002387 

002389 

002391 

002393 

002395 

002397 

002399 

002401 

002403 

002405 

002410 

002435 

002460 

002485 

002510 

002535 

002560 

002585 

002610 

002635 

002660 

002685 

002710 

002735 

002760 

002785 


ACCEPT 

AT  (01,01), 

"CRES:  Technical  Word  List  Print  Subsystem", 
Ar  (01,57), 

"(File  Selection  Screen)", 

A1  (02,01), 


AT  (04,12), 

"Welcome  to  the", 

Af  (04,28),  FAC(HEX( 85) ) , 

HEADERS, 

AT  (07,12), 

‘.Please  specify  the", 

AT  (07,31),  FAC( HEX( 84) ) , 

FILS, 

AT  (07,51), 

“you  want  to  print.", 

AT  (13,30), 

"File  =r", 

AT  (13, 43), FAC(GS), FILES  ,  CH(08), 

RANGE  (  "I  "  ,  "////////////" ) , 

AT  (14,30), 

"Library  =", 

AT  ( 14,43) ,FAC(L$) ,  LIBS  ,  CH(08), 

RANGE  (  'I  *  , 

AT  (15,30), 

"Volume  =*, 

AT  (  15,43), FAC(V$),  IVOL$  ,  CH(06), 

RANGE  (  *!  "  ,  , 

AT  (18,24),  FAC(MS),  MSGS, 

AT  (20, 30), "Press", 

AT  (20,36) ,FAC( HEX( 84) ) , 

ENTERS, 

AT( 20, 42) , 

"to  continue", 

AT  (21, 15), "Press", 

AT  (21,21),  FAC(HEX(84) ) , 

PF16S, 

Ar  (21,26), 

"to  return  to  the  Technical  Word  List  Menu", 

ON  (8IN( 16) 6BIN( 32) )  GOTO  OUT, OUT 

/*  SET  UP  THE  USER  FILE  BLOCK  */ 

SELECT  1 1 ,  "TECHFL* ,  VARC,  INDEXED, RECSIZS=40, K£YPQS=1 ,  KEYLEN=20 , 
IOERR  GOIO  IOERR1 

SELECT  *2,  "PRTFILE", PRINTER, RECSIZE=80, IOERR  GOIO  IOERRl 

/*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  V 

CALL  "LIMITS"  (FILES, LIBS,  I VOLS,  CODES,  MSGS) 

IF  CODE$="Y"  THEN  ZZZ 

IF  OODE$="N"  THEN  GOSUB' 7(FS,HEX( 91) ,HEX(  81 ) ,HEX(  81 ) ) 

IF  CODES =*V"  THEN  GOSUB' 7(SfR(MSG$, 3) ,HEX(  81 ) ,HEX(  81 ) ,HEX( 91 ) ) 
IF  CODE$=" L"  THEN  GOSUB' 7(STR(MSG$, 3) , HEX( 81 ) , HEX( 91 ) , HEX( 81 ) ) 
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002810 

002835 

002860 

002885 

002910 

002915 

002925 

002927 

002929 

002935 

002960 

002985 

003010 

003035 

003060 

003085 

003110 

003135 

003160 

003185 

003210 

003235 

003260 

003285 

003310 

003335 

003360 

003385 

003410 

003435 

003460 

003485 

003510 

003535 

003560 

003585 

003610 

003635 

003660 

003685 

003710 

003735 

003760 

003785 

003810 

003835 

003860 

003885 

003910 

003935 

003960 

003985 

004010 

004035 

004060 

004085 

004110 


IF  OODE$="E"  'MEN  G0SU8'  7(STR{  MSG$,  3)  ,HEX(  81 )  ,HEX(  81)  ,H£X(  81) )  RT 

GOTO  FILMNU  RT 

RT 

/*  IF  WE  FALL  HERE,  IT  MUST  3S  TIME  TO  OPEN  FILE  */  RT 

RT 

Z2Z:  CALL  "READFDR"  ADDR(FILE$,LIB$,IVOL$,0%,*HS’,RAG%,RET%)  JM 

IF  RAG%=40  THEN  ZZ1  JM 

GGSU8' 7(  E2$,H£X( 81) ,H£X( 81) ,H£X(81) )  JM 

GOTO  FIIMNU  JM 

ZZ1:  OPEN  NOGETPARM  #1, SHARED,  FILE=  FILES,  LIBRARY  =  LIB$,  ’.  JM 

VOLUME  =  IVOLS  RT 

RT 

READ  f 1, I08UFFS,  DATA  GOTO  IOERR2  RT 

IF  STR(  I08UFFS,  1,20)=  "  TECHNICAL  WORDS  *  THEN  YES  JM 

CLOSE  |1  RT 

MS=HEX( 94}  RT 

MSG$=  *  Please  specify  a  TECHNICAL  word  list."  RT 

GOTO  FILMNU  RT 

YES:  RT 

/*  This  section  of  code  generates  the  second  screen,  which  asks  */  RT 
/*  for  the  particular  word  interval  and  its  corresponding  */  RT 

/*  print  operation.  The  user  is  given  the  option  of  returning  */  RT 
/*  to  the  previous  screen  to  select  a  new  word  file  to  print,  */  RT 
/*  or  of  returning  to  the  technical  word  list  menu.  */  RT 

RT 

-itS  ="  "  RT 

RT 


CWMENU:  RT 


WORDS  =  "  " 

RT 

LPP% 

=50 

RT 

ENTERS 

=’ ENTER" 

RT 

PF15S 

=*"PF15" 

RT 

PF16S 

="PF16" 

RT 

SB TITLES 

_  m  m 

RT 

S8TITL1S 

_«  ■ 

RT 

5ALONEY: 

RT 

STARTPHS 

=" FIRST" 

RT 

ENDPHS 

="LAST" 

RT 

TP$ 

="  TERM  INAL* 

RT 

PRINTSCR: 

RT 

ACCEPT 

AT  (01,03), 

"CRES:  Technical  Word  List  Print  Suosystein", 
AT  (01,66), 

"(Print  Screen)", 

AT  (02,03), 


AT  (04,13), 


"To  print  a  range  of  lines,  fill  in  the  information  oelow.*, 
AT  (06,02),  F AC ( HEX (85)), 

SR $, 

AT  (08,22), 

"Subtitle  of  list  =", 

AT  (08,42),  FAC(HEX(81)),S8TirLE$,CH(20), 

AT  (09,42),  FAC(HEX(81)),S8TITLi$,CH(20), 

AT  (12,22), 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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004135  "Starting  word  =", 

004160  AT  (12,42), FAC(HEX(81) ) ,  STARTPH$,  CH( 20), 

004185  RANGE  (  *1  *  ,  '&£&&£££&' ) , 

004210  AT  (13,22), 

004235  'Ending  word  =’, 

004260  AT  (13,42),  FAC(  HEX(  81 ) ) ,  ENDPilS,  CH(20), 

004285  RANGE  (  *1  "  ,  *////////////’ ) , 

004310  AT  (14,22), 

004335  'Lines  per  paye  =', 

004360  AT  (14,42),  FAC( riEX( 62) ) ,  LPP*,  PTC(ff), 

004385  AT  (17,22), 

004410  "Print  at  (TERM INAL/ PR  INTER)  =", 

004435  AT  (17,53),  FAC(HEX( 81) ) ,  TP$,  CH(08), 

004460  AT  (22,32), 

0C4485  'Press', 

004510  A1  (22,38),  FAC ( HEX ( 85) ) ,  ENTERS  ,  CH(05), 

004535  AT  (22,44), 

004560  'to  print', 

004585  AT  (23,18), 

004b 10  "Press',  , 

0046. d  AT  (23,24),  FAC( ri6X( 34) ) ,  PF15$,  CH(04), 

004660  AT  (  23,29), 

004685  "to  select  another  Technical  Word  List", 

004710  AT  (24,18), 

004735  'Press', 

004760  AT  (24,24),  FAC( H£X( 84) ) ,  PF16S,  CH(04), 

004785  AT  (24,29), 

004810  "to  return  to  Technical  Word  List  Menu", 

004835  KEYS(8IN(  0) &3IN(  15)  &BIN(  16)  &QIN(  31 )  &3IN(  32) ) , 

004860  ON  ( BIN ( 15) &8IN( 31 ) &QIN( 16) &81N( 32) )  0710  NEW, NEW, EXIT, EXIT 
004885 

0049 10  /*  Make  sure  parameters  input  are  correct  */ 

004935 

0U496U  IF  oTR(TlJS,l,l)  =  *P"  THEN  NEXTli 

004985  IF  STR(TP$, 1, 1)  <>  fcT'  THEN  TERMPR 

005010  NEXTli:  IF  LPP* <  51  THEN  NEXT13 

005035  ER$="  Lines  per  page'  can  oe  at  most  50." 

005060  GOTO  PRINTSCR 

UU5085 

005110  rOERRl:  PRINT  /*  This  loop  used  it  I/O  error  */ 

005135  PRINT  UELL,HEX(94) 

005160  CLOSE  #1 

005185  FOR  1=1  TO  200U0U  : NEXT  I 

005210  GGTO  F1LMNU 

005235 

005260  TERMPR: 

005285  ER$=* 1  Pr  it  it  at  '  tus  only  legal  values  TERMINAL  or  PRINTER. 

005310  GOTO  PRINTSCR 

005335 

005360  REX:  Fut$="  'Starting  word'  comes  alter  'Ending  word 

005385  GOTO  PRINTSCR 

005410 

005435 

005460  rOF.RR2:  PRINT 

U05485  PRINT  HEX(  94 Error  occurred  on  Tile  FILE$ 

005510  PRINT  HEX( 94), "Error  code  =  FS ( # 1 ) 

005535  STOP  "Touch  ENTER  to  return  to  menu." 
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005560  GOIO  CWMENU  RT 

005585  RT 

005610  NEXT13:  IF  STARTPtifc="F IRST"  OR  ENDPH$=*LAST*  THEN  FORD  RT 

005635  IF  STARTPHS > END PH$  THEN  REX  RT 

005660  RT 

005685  /*  Now  it's  time  to  generate  our  print  file  name  */  RT 

005710  RT 

005735  FORD:  DAT$=*  DATE  RT 

005760  D$=  S'IR(OAT$,3,2)S,"/"&STR(DAT$,5,2)£."/"&STR(DAr$,i,2)  RT 

005785  T$=  STR( TIME, 1, 2) &" : "&STR(TIME, 3, 2)  RT 

005810  RT 

005835  DISPLAY  I  JM 

005860  AT  (01,03),  ! 

005885  "CRES:  Technical  Word  List  Print  Subsystem*,  I  JM 

005910  AT  (01,61),  ! 

005935  "(Generation  Screen)*,  I  JM 

005960  AT  (02,03), 

005985  '^====a======— 

006010  =============*,  : 

006035  AT ,( 12,23),  I 

006060  "Output  file  now  being  generated!"  JM 

006085  PFILE$=*TECHWD##*  RT 

0061 10  r%=0  RT 

006135  NEXT14:  CONVERT  I*  TO  STR( PFILE$,7, 2) ,PIC( 00)  RT 

006160  I*=I%+1  RT 

006210  CALL  "LIMITS"  ( PF I LE$,SLIB$,SVOL$, CODES, MSGS)  JM 

006235  IF  CODB$="Y*  THEN  NEXT! 4  RT 

006245  IF  C OD£$="£"  THEN  ER$  =  STR(MSG$,3)  JM 

006255  IF  OODE$="E"  THEN  PRINTSCR  JM 

006260  OPEN  NOGETPARM  #2,OUTPUT,FILE=PFILE$,LI8RARY=SLIB$,  !  JM 

006285  VOLUME=SVOL$,SPACE= 12000  JM 

006310  JM 

006335  GOSUB  TTL_PGE  JM 

006360  IF  STARTPH$  ="PIRST"  THEN  READ  »1,KEY>"  TECHNICAL  WORDS",'.  JM 

006385  IOBUFFS  ELSE  READ  »!,' KEY>STARTPH$,  IOBUFFS  JM 

006410  IF  ENDPHS  =  "LAST"  THEN  ENDPH$  =  ALL(HEX(FF) )  JM 

006435  PAGE*  =1  JM 

006460  R£GS%  =  1  JM 

006485  GOSUB  HEADER  JM 

006510  IF  STR( IOBUFF$, 1, 20)>ENDPH$  THEN  HOME  JM 

006535  GOTO  KNOT  JM 

006560  AGAN:  READ  # I,  IOBUFF$,£OD  GOTO  HOME  JM 

006585  IF  STR(  IOBUFFS,  1, 20)>ENDPH$  TiiEN  liDME  JM 

006610  IF  RECS%  =  1  AND  PAGE*  <>  1  THEN  GOSUB  HEADER  JM 

006635  KNOT:  IF  STR(  IOBUt  1, 20)="  TECHNICAL  WORDS*  THEN  AGAN  JM 

006660  PSN=  P0S(  "  JVC  jNOInAPf3ad"a>  STR(  IO0UFF$,21,1) )  JM 

006666  IF  PSN=0  TKJl  PSN=14  JM 

006667  IF  PSN=14  THEN  A$ ( 1 4 ) =STR ( IOriUFF$,  21,1)  JM 

006685  IF  STR ( IOBUF F$ ,22,1)="*"'  THEN  STR(  IOBUFFS, 22, 1  )»"P"  JM 

006710 

006735  /*  no  we  need  1 +=Rooc  Word'  or  ' BOLDFAC£=Root  Word'?  */ 

006760 

006785  IF  S  "A  ( TPS  ,1,1)="T"  THEN  BUG 

006810  WRITE  72,  USING  CAT6,C$,"  ’ ,STR( IOBUFFS, 1, 20) ,  I  RT 

006835  A$(  PSN )  ,STR(  IOBUFFS, 22, 1 )  ,STR(  IOBUFFS,  27,1)  RT 

006860  IF  (STR( IOBUFFS, 26,1)0 "*")  THEN  BAS 

006885 


93 


2/4 
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006910  /*  It  this  is  a  rootword  at  printer,  make  word  BOLDFACE  */ 
006935 

006960  C$=HEX( 0000) 

006985  WHITE  #2,  USING  CAT9,  Ofi,  STH(  IOBUFF$,  1, 20) 

007010  WhiTE  |2,  USING  CAT9,  C$,  S'TR(  IOBUFF$,  1, 20) 

007035  C$=HEX( 0001 ) 

007060  GOTO  BAG 

007085 

007110  /*  Turn  ROOTWORD's  "**  into  "a*  for  TEAM  INAL  output!  */ 

007135 

007160  BUG:  IF  STR( IOOUFFS, 2u, 1 )=**"  THEN  STR( IOBUFF$, 26, 1 ) =" t* 

007185  WRITE  #2,  USING  CAT6,CS ,STR(  IOBUFFS,  26,1)  ,S'K(  IOBUFFS,  1, 20) 

007210  AS(PSN)  ,STR(  IOilUFFi ,22,1), STR j  IOOUFFS,  27,1) 

007235 

007260  dAG:  RECS%=RECS%+1 

007285  IF  RECS%>LPP%  THEN  RECS%=1 

007310  IF  RECS%=1  THEN  PAGE*=PAGE*+1 

007335  GOTO  AGAN 

007360 

007385  HOME:  /*,Need  to  print  'END  OF  LISTING'  and  '(?)=Root  Word*  */ 

007410 

007435  IF  RECS%=1  THEN  RECS%=51 

007460  WRITE  |2,  USING  DOG,  C$ 

007485  R£CS*=R£CS'*t2 

007510  WRITE  #2,  USING  DG,  C$ 

007535  FOR  I  =  RECS%  TO  LPP%tl 

007560  WRITE  #2,  USING  DOG,  C$ 

007585  NEXT  I 

007610  IP  STO(TP$, I, 1 )=*P*  THEN  HERi 

0U/635  WRITE  #2,  USING  CATd,  C$ 

007660  GOTO  HER 

007685  HERI:  WRITE  »2,  USING  RAT,  C$ 

007710  CS=-HEX(000U) 

007/35  FOR  1=1  TO  4 

007760  WRITE  |2,  USING  RATI,  C$ 

007785  NEXT  I 

007810  CS  =  HEX(0001) 

0C7d35  HER:  CIlDSE  *2 

007860  IF  STR ( TP$ ,1,1)  ="P"  THEN  MESS 

007685  CuUSE  ws 

007910  MSG2S  =  "CANCEL  Processing" 

00/935  MSK$=HEX( 00) 

007960  CMSG$  =  *  " 

0U7985  CALL  "LINK"  ADDR( “DISPFILE" , "p"  ,RuId$,RvOLS,  3* , PFILE$, 

OOdOlU  SLIB$,SVUL$,"C",MSG2$, 27%, "ri* ,MSX$,CMSG$,  255%,  Ci,R%) 

008035 

00d060  Ei<£  =  *  " 

008085  IF  CtOO  OR  HiOO 

008110  THEN  ER$  =  STR(CMSG$, 141 ) 

008135  GOTO  GiMENU 

008210 

008235  MESS:  EA$="  File  *<.PFILE$f>“  in  LiDrary  mh  SLIBf  S"  on  “i, 

008260  SVOL$  generated." 

008285  GOTO  BAIjlDNSy 

008310 

008335  NEW:  PRINT  PAGE,  AT(  12,28)  ,HEX(34)  .-"Closing  last  file" 

003360  FOR  1=  1  'TO  50000  :NF.XT  r 
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008335  CLOSE  #1 

RT 

008410  GOTO  AGAIN 

RT 

008435 

RT 

008460  TTL  PGE: 

RT 

008483 

C$=HEX( 8001 ) 

RT 

008510 

WRITE  |2,  USING 

DOG,  C$ 

RT 

008533 

C$  »  HEX( 0015) 

RT 

008560 

WRITE  #2,  USING 

DOG,  C$ 

RT 

008585 

C$  =  HEX(000i) 

RT 

008610 

WRITE  #2,  USING 

DOG1,  CS 

RT 

008635 

WRITS  #2,  USING 

DOG2,  C$ 

RT 

008660 

WRITE  #2,  USING 

DOGO,  C$,D$,T$ 

RT 

008  685 

WRITS  |2,  USING 

DOG3,  C$ 

RT 

008710 

WRITE  #2,  USING 

DOG2,  C$ 

RT 

008735 

WRITE  |2,  USING 

DOG1,  C$ 

RT 

008760 

WRITE  #2,  USING 

DOG 2,  C$ 

RT 

008785 

IP  S8TITL£$  -  " 

‘  THEN  GERR/ 

RT 

008810 

WRITE  |2,  USING 

DOG4,  C$,  SariTLES 

RT 

008835 

IP  SBTITLISO" 

*  THEN  i<RI  TE  42,  USING 

I  RT 

008860  DOG10, 

C$,  /SBTITLIS 

RT 

008885 

WRITE  #2,  USING 

DOG2,  CS 

RT 

008910  GERR¥: 

WRITE  |2,  USING 

DOG5,  C S,  PILES 

RT 

008935 

WRITE  |2,  USING 

DOG2,  C$ 

RT 

008960 

WRITE  #2,  USING 

DOG6,  C$,  LIB$ 

RT 

008985 

WRITE  42,  USING 

DOG2,  C$ 

RT 

009010 

WRITE  #2,  USING 

DOG7,  C$,  IVOLS 

RT 

009035 

WRITE  #2,  USING 

DOG2,  CS 

RT 

009060 

WRITE  42,  USING 

DOG8,  C$,  STARTPHS 

RT 

009085 

WRITE  42,  USING 

DOG2,  CS 

RT 

009110 

WRITE  42,  USING 

DOG9,  C$,  ENDPH $ 

RT 

009135 

WRITE  42,  USING 

DOG2,  C$ 

RT 

009160 

WRITE  42,  USING 

DOG1,  C$ 

RT 

009185 

RETURN 

RT 

009210 

RT 

009235  HEADER: 

/ 

RT 

009260 

IF  PAGE%=1  THEN 

FIRST 

RT 

009285 

C$  =  HEX(OOUl) 

RT 

009310 

IP  STR(TP$,1,1)= 

=*P*  THEN  F8ST1 

009335 

WRITE  *2,  USING 

DOG,  C$ 

RT 

009360 

WRITE  42,  USING 

CAT8,  C$ 

RT 

009385 

GOTO  FIRST 

009410  FRST1: 

WRITE  42,  USING 

DOG,  C$ 

009435 

WRITE  42,  USING 

RAT,  C$ 

009460 

C$=HEX(0000) 

009485 

FOR  I  =  1  TO  2 

RT 

009510 

WRITE  42,  USING  RATI,  C$ 

009535 

NEXT  I 

009560  FIRST: 

C$  =  HEX(8001) 

RT 

009585 

WRITE  12,  USING 

DOG,  C$ 

RT 

009610 

C$  =  HEX(0001) 

RT 

009635 

IF  S8TITLE$  =  " 

l» 

1  RT 

009660 

THEN  WRITE  #2,  USING  CAT, C$,D$,T$, PAGE* 

:  RT 

009685 

ErSE  POUT 

RT 

009710 

GOTO  ALR1TE 

RT 

009735  POUT: 

WRITE  42,  USING 

CAT1 ,  CS ,  SB  TITLES ,  D$ ,  T$ ,  PAGE% 

RT 

009760 

if  sonru$<>‘ 

m 

1  RT 

009785 

THEN  WRITE  42,  USING  CAT7,C$,SBTITLi$ 

RT 

yb 
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009810  ALRITE:  WHITS  »2,  USING  CAT2,  C$,  FILE$,  LIES,  IVOL$  RT 

00983b  WRITS  #2,  USING  CAT 3/  C$  HT 

009860  WHITE  #2,  USING  CAT4,  C$  HT 

009885  WHITE  |2,  USING  CATS,  C$  HT 

009910  WRITE  #2,  USING  CATV,  C$  HT 

009935  RETURN  HT 

009960  RT 

009985  DOGO:*M  **##»»**  !  HT 

oiooio  mmi  :  rt 

010035  DOG:  %||  HT 

010060  DOG1 :  %M  I - '.  RT 

010085  - 1  HT 

010110  DOG2:%M  !  !  HT 

010135  :  HT 

010160  DOG3:MI  :  ******  TECHNICAL  WORD  LIST  ***!  RT 

010185  **  :  RT 

010210  JOG4:MI  TITLE  OF  LIST:  ItMMMMM MM!  HT 

010235  Mil  I  RT 

010260  iXX15:%M  I  INPUT  FILE:  IMIMM  l  HT 

010285  ,  !  HT 

010310  DOG6:%#l  !  INPUT  LIBRARY:  MliMi#  l  RT 

010335  !  HT 

010360  UX37:*M  .’  INPUT  WUJME:  II MM  HT 

010385  :  RT 

010410  DJG8:  *1#  1  STARTING  WORD:  MMMMMIMIMI  RT 

010435  MM  I  HT 

010460  DOG9 : %M  I  ENDING  v*0RD:  MMMMMMMM:  RT 

010485  till  I  HT 

010510  DOGIO:*##  MiMMMMMM!  HT 

010535  Mil#  !  RT 

010560  DG:%M  ! ENO  OF  LISTING  111  RT 

010585  CAT : % # #  IMIMM  tiff#  PAGE  MM#  HT 

010610  CATlrM#  TITLE  OF  LIST  :  MMMMMMMMMM  MMMM  !  RT 

010635  IMM  PAGE  IMM  HT 

010660  CAT7 : %##  MMMMMMMMMM  HT 

010685  CAT2:%M  Input  File  is  MMMM  in  Liocar/  MMMM  on  Volume  III!  RT 
010710  Mi  RT 

010735  CAT 3 :  J||===============»*»»*=*»***»***”******M»***M===as*=*-a!  RT 

010/bU  =-===================  RT 

010785  CAT4 : 4 II  WORD  Part  of  Past  1  HT 

010810  Mandatory  RT 

U 10835  CATT :  M#=- --  =  -=-=-=  ===  =  ==-==■==-=*  ===-======-  = -  ====-  - ----===-==--=!  HT 

010860  *  •••  »»*=*^~*  HT 

010885  CAT5:MI  Speech  Participle  !  HT 

010910  i  vlmtil  W.ird  HT 

0109  35  CATb:M»  I  I II 1 1 1 1 II II 1 1 1 M  I#  I#  IMIMIMI  I  I  HT 

010950  •  HT 

010985  HT 

011010  OAT9:  *##  MMMMMMMMMM 

011035  CA I'8 : 4 II  +-  =  Root  Word  HT 

011060  HAT:  ill  801  Jr  ACE  =  Hoot  Word 

01  1085  RAri:*M  JOLDFACE 

011110  HT 

011135  /*  THIS  FJNCi’ION  PH  INIS  OUT  ERROH  MESSAGES  AND  */  RT 

011160  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  Pi  ACES  */  RT 

011185  DEF  FN '  1  ( MSGS ,  13$ ,  C$ ,  D$ )  RT 

011210  PRINT  RT 
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Page 


011235  M$«H£X(94) 

011260  G$=S$ 

011285  L$=C$ 

011310  V$-D$ 

011335  RETURN 
011360 

011385  EXIT:  CLOSE  II 
011410  OOT:  /*  RETURNING  TO 


fECHNICAL  k»RO  LIST  MENU  »/ 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 


t ' 


n 


A 


y7 


A 


■  -.< 


•-»  • 


CRESPTPA  in  library  CRES@SRC  is  the  BASIC  language  program  to  print  the 
technical  word  list  by  attribute.  The  object  language  version  is  CRES@TPA  in 
1 ibrary  CRES0SAV. 

This  program  first  allows  the  user  to  specify  the  technical  word  list  to 
be  printed  and  the  attributes,  (part  of  speech,  past  participle,  form  of  the 
verb  "to  be",  negative  or  root  word),  to  be  included.  See  table  1  for  a 
definition  of  the  parts  of  speech. 

If  a  particular  part  of  speech  is  selected  which  also  appears  in 
combination  with  some  other  part(s)  of  speech,  all  combinations  which  contain 
the  originally  specified  part  of  speech  will  be  included.  (For  example, 
selecting  verb  will  produce  a  list  of  verbs,  adverb/verbs,  noun/verbs,  and 
adjective/verbs.)  More  than  one  attribute  can  be  selected,  and  all  words 
containing  any  attribute  selected  will  be  included  in  the  printout.  If  the 
root  word  attribute  is  selected  in  combination  with  another  attribute,  then 
only  root  words  possessing  that  attribute  will  be  printed. 

The  user  can  select  a  subtitle  of  up  to  two  lines  to  be  printed  on  each 
page  of  the  output  listing.  The  output  listing  can  be  sent  to  either  the 
terminal  or  the  printer,  it  can  encompass  the  entire  output  list  generated,  or 
any  portion  thereof,  and  the  number  of  lines  per  page  can  be  specified. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010  /*  This  is  the  CRES  TECHNICAL  PRINT  8*  ATTRIBUTE  PROGRAM  V  JM 

000030  /*  V 

000050  /*  AOTHORS:  Rose  Tank  and  John  Meats  */ 

000070  /*  Date:  October  12,  1983  V 

000090  /*  V 

000110 

000130  /*  The  following  code  sets  up  a  screen,  which  asks  for  the  V 

000150  /*  name  of  the  file  containing  the  Technical  Word  List  */  JM 

000170  /*  to  De  printed.  It  also  provides  the  opportunity  to  change  */ 

00C190  /*  the  library  and  voIuitb  names  which  are  set  to  the  appro-  V 

000210  /*  priate  defaults  through  the  'Extract*  system  routine.  */ 

000230 
000250 

000270  DIM  WORDS24,ERRlS60,a>DE$l,MSG$50,FS40,G$i,CKSG$255,MSG2S40 

000290  DIM  Pl$20,IOBUFF$64,R\roU06,PFIL£$08,FILE$a,LIB$B,IVOL$6  JM 

000310  DIM  RNT£R$5,PF14$4,PF15S4,PF16$4,£RS79,FILS19,E2S38  JM 

000330  DIM  HEADER$51,LS1,V$1,B$1,C$2,D$8,M$1,MSK$2 

000350  DIM  S3TITLES20,A£i  20)15, S3TirLlS20<STARTPH£20,ENDPH£20,TPS8 

000370  DIM  PSPCriT$15,OTHERS$16, T$(  20) 1 ,RLI8$8 ,SLIB$8,SVOLS6  JM 


000390  ' 

000410  A$( 1 ) =  'adjective' 
000430  A$(2)-  'verb' 
000450  A$(3)  =  "conjunct." 
000470  A$(4)-  'adj/vero' 
000490  Ai>(  5)  =  'noun' 
000510  A$(6)=  'pronoun' 
000530  A$(7)=  "interject" 
000550  AS(8)=  "noun/vero' 
000570  A$(9)=  'adverb' 
000590  AS( 10) ="preposit" 
000610  A$(  ll)=*“article“ 
000630  Ai( 12)='adv/vero* 


000650  A4( 13)='noun/adj"  RT 

000670  AS(14)='past  participle"  ,  RT 

000690  A£(15)»'to  be"  RT 

000710  AS( 16)=" negative'  RT 

000730  ASl  17)="rtvand.tech.word'  RT 

000750  A$(18)-’root  word'  RT 

000770 

000790  PlS=HEX(0014000i00010001000jA001000i0003QOUB) 

000810  ENTERS-' ENTER':  PF14S  ='PF14' : PP15S='PF15" : PF16$='PF16’  RT 

000812  A'lTR I BUTESS-  " ATI R IBUTES"  RT 

000830  PSPCTITS  -’Parts  of  Speech' 

000850  OTHERSS  -"Other  Attributes' 

000670  FS=  'Filename  not  found  on  ( liorary/voiume) .  ' 

000890  E2S=  "  Please  specify  a  TECHNICAL  word  list.'  JM 

000900  ERR1S  =  '  I/O  ERROR  -  Please  specify  a  TECHNICAL  word  list.'  JIM 

000910  HEADERS  -'CRES  PRINT  WL  At  ATTRIBUTE  SUBSYSTEM'  JM 

00093U  FILS  -'Technical  Word  List* 

000950  CALL  'EXTRACT"  ADDR(  'RV'  ,RVOL$ , 'RL'  , RlIBS,  "SL*  , SLIBS,  “SV"  ,S\OL$,  1  JM 
000952  "IL',LIBS,'IV',IVOL$)  JM 


000970  FILES-'  ' 

001010  AGAIN:  G$=rtEX(81) 

001030  MSGS-'  “  :  L$=rlEX(  81 ) 

001050  VS-HEX(dl):  M$=HEX(6D) 

001070 

001090  PIlMNU: 


101 
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U0IU0  ACCEPT 

001130  AT  (01,01), 

001150  "CRES:  Print  Technical  Word  List  oy  Attnoute  Suosystem" , 

001170  AT  (01,57), 

001190  “(File  Selection  Screen)*, 

001210  AT  (02,01), 

001230  *==  =  =  ======================-== =================================== 

001250  ===============*, 

001270  AT  (04,19), 

001290  "Welcome  to  the", 

001310  AT  (04,30),  FAC( HEX( 85) ) , 

001330  HEADERS, 

001350  AT  (07,12), 

001370  "Please  specify  the", 

001390  Ar  (07,31),  FAC(HEX(  84) ) , 

001410  FILS, 

001430  AT  (07,51), 

001450  "you  want  to  print.", 

001510  AT  (13,30), 

001530  "Pile  r=»", 

001550  Ar  (13,43),FAC(G$) , PILES  ,  CH(08), 

001570  [LANGE  (  "1  "  ,  &£&£'), 

001590  AT  (14,30), 

001610  "Liorary  =", 

001630  AT  ( 14,43)  ,FAC( LS) ,  LIDS  ,  CII108), 

001650  RANGE  (  "1  "  ,  m ittiitititii' ) , 

001670  AT  (15,30), 

001690  "Volume  =", 

001710  AT  ( 15,43) ,FAC( V$) ,  IVOLS  ,  CH(0b), 

001730  RANGE  {  "I  "  ,  ' ttttttttttit * ) , 

001750  AI'  (18,24),  FAC(rtS),  MSGS, 

001770  AT  (20, 30), "Press", 

001790  AT  (20, 36), FAC(HEX(  84)), 

001810  ENTERS, 

001830  Ar(  20 , 42 )  , 

001850  "to  continue", 

001870  AT  (21, 15), "Press", 

001890  AT  (21,21),  FAC( H£X(  84 ) ) , 

001910  PF16S, 

001930  Ar  (21,26), 

001950  "to  return  to  the  r<*chmcai  Word  last  Menu", 

001970  ON  (D1N(  16)&JIW(  32) )  ilDiU  OUT 
002010 

0020  30  M$=:IF.X(  8D>:M.;'S-’  " 

1)02051)  /*  SET  OP  TOE  USER  FILE  DLOCK  */ 

002070 

002090  SELECT  #  1 ,  *  rECHNIC"  ,  VARC,  INDEXED, RECS 12 E=40,KEypOS=l,XE7LEN=20, 

0021  10  IOERR  GOTO  IOERR1 

002130 

002150  SELECT  »2,  "PHTFILE"  ,  PRINTER, RECSIZE=80,  IOERR  GOTO  I JERRI 
002170 

002190  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  »/ 

002210 

0022)0  cat.  *;.r'iirs"(Fi:."S,Liss,ivoLS,coDE$,[4SGS) 

002250  IF  CODES***"  TIEN  LLl 

002270  IF  CUDS* -’N*  THEN  GOSJJ*  7,  FS, HEX(  91 )  ,HEX(  81 ), iIEXi  81 )  ) 

002290  IF  CODES ~  "  V"  THEN  GJGJd'  /( SIR (MSGS,  3 ) ,  HEX(  81 )  ,  HEX(  8 1 ) ,  HEX(  9 1 ) ) 


G  2*  ."v  2- 
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002J10  IP  COOE*=*L“  MEN  GOSUB'  7(STR( MSG* ,  3)  ,H£X(  81)  ,HEX(  91 )  ,HEX(  81 ) ) 
002330  I?  CODE*="E"  MEN  GOSUB'  7(STR(MSG*,  3)  ,H£X(  81)  ,HEX(  81 1  ,HEX(  31)  1 
002350  GOK)  rILMNU 
002370 

002300  /*  OOP  PICK  EXISTS,  BUT  IS  IT  A  TECHNICAL  WORD  LIST?  */ 

002414 

002416  IU\  CALL  "READFDR"  AD0R(  FILE*, LIB* ,  I  \ADL*,0%,  *RS"  ,RAG*,RET% ) 

002418  IP  RAG%-40  MEN  ZZ1 

002420  GOSOB' 7 ( E2*, HEX( 81) ,HEX(  81)  ,HEX(  81) ) 

002422  GOTO  PILMNU 

002430  221:  OPEN  NOGETPARM  |1,SHAREl>,  FILE=  FILES,  LIBRARY  =  LIBS, 

002450  VOLUME  =  IVOL* 

002490  READ  #l,IOBUFF*,  DATA  GOOD  IOERR2 

002510  IP  STR( lOBCIFF*, ,  16 )  =  "  TECHNICAL  WORDS’  THEN  7ES 

002530  CLOSE  #1 

002~50  M$=HEX( 94 ) 

002570  MSG*=>  E2$ 

002590  OJ'IO  PILMNO 

002610  7ES: 

002630  X* ="X“ :  RJ7FL=U:  FOR  1=1  IO  18:  T*(I>="  *:NEXT  I 
002650 

002670  ACCEPT 

002690  AT  (01,03), 

002710  "CRES:  Print  ML  ny  Attribute  Subsystem  (Attrioute  S< 

002730  ction  Screen)*, 

002750  AT  (02,03), 

002  770  "  =====================*====*=========»================■========== 

002790  ^  =  = 

002810  AT  (04,03), 

002830  *  Place  an", 

002850  AT  (04, 14) , FAC  (HEX (85) ) ,X$,  CH(01), 

002370  AT  (04,16), 

002390  "ocside  the  attrioute  or  combination  of  attributes  to  do  printi 
002910  ", 

002930  AT  (05,03), 

002950  "If  you  choose  a  part  of  speech  which  is  included  in  a  coituinal 
002970  n,  then  the", 

002990  AT  (06,03), 

003010  "combination  will  also  ue  printed,  (e.g.  If  adverb  is  selected, 
003030  hen  adv/veros", 

U03U50  AT  (07,03), 

003070  "will  be  printed  as  well  as  the  adverbs.)  If  the  root  word  opt 
003090  n  is  selected  ", 

003110  AT  (08,03), 

003130  "in  combination  with  another  attrioute,  then  only  root  words  w 
003150  that.  ", 

003170  AT  (09,03), 

003190  "attribute  will  do  printed.", 


ACCEPT 

AT  (01,03), 

"CRE3:  Print  ML  ny  Attribute  SuDS/stein 
ction  Screen)", 

AT  (02,03), 


(Attrioute  Seie 


AT  (04,03), 

*  Place  an", 

AT  (04, 14), P AC (HEX (85) ) ,X$,  CH(01), 

AT  (04,16) , 

"beside  the  attrioute  or  contnnation  of  attributes  to  be  printed. 
AT  (05,03), 

"If  you  choose  a  part  of  speech  which  is  included  in  a  coinuinatio 
n ,  t  hen  t  he" , 

AT  (06,03), 

"combination  will  also  oe  printed,  (e.g.  If  adverb  is  selected,  t 
hen  adv/veros", 

AT  (07,03), 

"will  be  printed  as  well  as  the  adverbs.)  If  the  root  word  optio 
n  is  selected  ", 

AT  (08,03), 

"in  combination  with  another  attrioute,  then  only  root  words  with 
that  ", 


AT  (09,03), 

"attribute  will  oe  printed.". 


003210 

AT  (  11,37), 

FAC(HEX(AD) ) , 

ATTRIBUTES* 

,  CH(10), 

RT 

003230 

AT  (13,14), 

FAC(riEX( AC) ) , 

pspcrir* 

,  01(15), 

RT 

003250 

AT  (13,55), 

FAC( HEX (AC) ) , 

OTHERS* 

,  CHl 16) , 

RT 

003270 

AT  (  14,05), 

Ri' 

003290 

"adjective"  , 

RT 

003310 

AT  (  14,18), 

PAC(HEX( 81)), 

T*(  1 ) 

,  CH (01), 

RT 

003330 

AT  (14,24), 

RT 

003350 

■fioJu/veru" , 

RT 

00)370 

AT  (  14,36), 

PACl  HEX(  81 )  ) , 

T*(  8) 

,  Cri(Ol), 

RT 

103 
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003390 

AT  (  14,55), 

003410 

"past  participle", 

003430 

AT  (14,71),  r'-AeUrlXiOl)), 

r£(  14) 

,  CH (01), 

003450 

AT  (15,05), 

003470 

"verb", 

003490 

AT  (15,10),  r'ACi  H.-3X(  81 ) ) , 

T$[2) 

,  CH(01), 

003510 

AT  ( 15,24)  , 

003530 

"ddvero"  , 

003550 

AT  (  15,36),  AC  (  rir)X  (  8 1 )  ) , 

T$  ( 9 ) 

,  Cri(01) , 

003570 

AT  ( 15,55) , 

003590 

"to  oe", 

003610 

AT  (15,71),  r  AC(  ;lrlX(  81 )  ) , 

T$(15) 

,  CH(0i), 

003630 

AT  (16,05) , 

003650 

"con]unct ion" , 

003670 

AT  (16,18),  FAC( l(CX( 81 ) ) , 

rs  ( 3 ) 

,  Cri(Ol), 

003690 

AT  ( 16,24)  , 

003710 

"preposition" , 

003730 

AT  (16,36),  r’ACi  :U'.K(  81)), 

r$(  10) 

,  Crf(Oi), 

003750 

AT  ( 16,55) , 

003770 

"nogati  ve"', 

003790 

AT  (  16,  71)  ,  r  AC(  ,!  '.<(  3  1 ) ) , 

T$( 16) 

,  Cri(Ol), 

003310 

AT  (17,05), 

003630 

"adj/vero" , 

00  3350 

AT  (17,18),  r’AC(  Hr)X(  8 1 ) ) , 

rf  ( 4) 

,  CH( 01 ) i 

0033  70 

AT  (17,24), 

003390 

"article" , 

003910 

AT  (17,36),  r'ACt rirlAi  81 ) ) , 

i'S(ll) 

,  cat oi) 

003930 

AT  (17,55), 

003950 

"nund  loch  words", 

00  3970 

AT  (17,71),  r'ACi  rlrJXl  81)  ), 

l’$  ( 1 7 ) 

,  CH  (01). 

003990 

AT  (18,(J-i), 

004010 

"noun* , 

004030 

AT  (13,18),  l-'ACi  rfrIXi  81)  ) , 

T$  ( 5 ) 

,  Ctl(Oi) 

004050 

A  2  (  18,21), 

004070 

"a  iv/vero* , 

004090 

AT  (18,36),  r'ACi  drlXi  81)  ), 

rS( 12) 

,  CH(01) 

004110 

AT  (13,55), 

004130 

"root  word", 

004150 

AT  (18,71),  rAC(iiEXtai)), 

r$(l8) 

,  Crf(Ol) 

UU41  /u 

AT  (19,03), 

004190 

“pronoun" , 

004210 

AT  (19,18),  r  AC(  ilr'.X!  8 1  ) ) , 

T$(6) 

,  CH (01) 

004230 

AT  (  19,24)  , 

004250 

"n  >.  in/ad  i" , 

00  12  70 

A  i-  (19,  3o  )  ,  r  AC(  dr: ■(  i  8  1  )  )  , 

rtf  13) 

,  CH(0i) 

.104290 

AT  (20,0b), 

iio4  no 

"  interject  ion". 

104330 

AT  (20,18),  r’ACi  ririx(  81)), 

r£(7) 

,  CHiOl) 

404  150 

AT  (21,24/,  FAC(Mt), 

MSGf 

,  CH( 45) 

304370 

Ai'  i  22, 30)  , 

904  NO 

“cress* , 

004410 

AT  (22,  40),  r’ACi  ilFX(  85  )  ) , 

enters 

,  CH( 05) 

7944  33 

AT  (22,42/, 

|)  4450 

"to  con;  in.ie" , 

04  44  79 

AT  (2),  17), 

0044  * J 

90i-nn 

AT  (2i,2t),  r’AC(:li’.X(34)  ), 

Cr’ISi, 

,  Cri( 04) 
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004 i 30 
004330 
004002 
004004 
004536 
004008 
004560 
004370 
004090 
004610 
004630 
004650 
004670 
004690 
004710 
004730 
004750 
004770 
004790 
004810 
004830 
U04850 
004852 
004634 
004656 
004858 
004660 
004862 
004664 
004666 
U04do8 
004670 
004840 
0044-10 
004930 
004950 
004970 
004990 
004992 
005010 
005030 
005050 
005070 
005040 
005110 
005130 
005150 
0051  h) 
0U5I90 
005210 
0052  iO 
005290 
005.ro 
0032  K) 
09  j  3 10 
):I5  t  61 
J  0  3  3  3  i 


AT  (23,28), 

"to  select  another  Technical  Word  List", 

AT  (24,15), 

"Press" , 

AT  (24,21),  FAC(ri£Xld4)),  pc’ 16$  ,  Cri(04), 

AT  (24,26), 

"to  return  to  the  Tecnrucal  Word  List  Menu", 

KEW(81N(0)&alN(  15UriiNi  31 J  f.8IN(  16)  &6IN(  32)), 

UN  (81N(15)68IN(31)u.diN(  16)681.4(32))  GUIO  NEW, NSW, EXIT, EXIT 

MSG$="  "  :M$=.4EXi8J)  :  K=0 
FOR  I  1  W  17 
PSN=POS("  X*=T$( I ) ) 

IF  PSN=»0  THEN  INPTER 
IF  PSN=2  THEN  K=1 
NEXT  I 

If'  6=1  THEN  4852 

IF  K=0  AND  r$(18)  =  "X"  THEN  RTFL=2  ELSE  INPTER 
GOTO  4852 

INPTER:  MSG$="Please  use  only  'X'  to  mark  attributes.” 

M$=HEX( 94 ) :  3010  yES 


r$(l)<>"X"  THEN  4856 
T$( 4) ="X* :  T$(1J)='X" 
r$(2X>"X"  THEN  4862 


/"If  adj  was  marked  then  */  RT 
/"also  print  adj/vecD  &  noun/adj*/  R1 
/"If  veto  was  marked  then  also  */  RT 


T$(  4)="X“ :  T$(8)="X":  T£(  12)="X“/*pnnt  adj/vero,  noun/ verb*/  RT 


I  =14  IO  17:  IF  T$( I)="X* 


/*  i  aav/ veto 

/"If  noun  was  narked  then  also 
/"print  noun/ve ro  a  noun/adg 
/"If  adv  was  marked  then  also 
/"print  adv/vero 


/*  it  aav/ veto  */  RT 

r$(  5)<>"X"  THEN  4866  /"If  noun  was  narked  then  also  "/  RT 

f$(8t='X”:  I'£(13)="X"  /"print  noan/vecu  a  noun/adj  */ RT 

r$(9)="X"  rHEN  T$(  12)="X*  /"If  adv  was  marked  then  also  */  RT 

/"print  adv/vero  */  RT 

RT 

4  I  =14  IO  17:  IF  r$(I)="X"  THEN  r$(I)="*"  ELSE  l’$(  I)  ="$"  .-NEXT  I  RT 
K=  1  AND  r$(18)="X"  THEN  RTF  Lai  RT 

This  section  of  code  generates  the  tmcd  screen,  which  asxs  */  JM 
for  the  particular  word  interval  and  its  corresponding  */  JM 

print  operation.  The  user  is  given  the  option  of  returning  */  JM 
to  the  previous  screen  to  select  different  attriDutes,  or  of  */  JM 
returning  to  the  first  screen  to  select  a  different  word  nle*/  JM 
or  of  returning  to  the  Technical  Word  List  Menu.  */  JM 


er$  ="  * 

CWMF.NJ : 

.11.13$  =  "  * 

Li'ih  =50 

PF 15$  ="PF 15" 

PF  i  6$  =  “  PF  1 6  " 

JJi’l  TLE$  =*  " 

3rinr;,i$  =*  • 

JAhWEi : 

TP$ 

S  TAR  T  PH$ 

ENJPilS 
PR  IN  75  JR : 

A. VERT 

AT  (01,03), 


="  TERMINAL 

=viR.sr 

=‘LA3r* 
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000370  "CKOS:  Print  Technical  Word  List  oy  Attrioite  Suosystem", 

005390  AT  (01,66), 

005410  "(Print  Screen)*, 

005430  AT  (02,03), 

00^470  =============*, 

005490  Ar  (04,13), 

005510  "To  print  a  range  of  lines,  fill  in  the  information  Deiow.", 
005530  AT  (06,02),  FAC( HEX( 85) ) , 

005550  ER$, 

00557U  AT  (08,22), 

005590  "Suotitle  of  list  =", 

005610  AT  (08,42),  FAC( HEX( 81 ) ) ,S3TI TL£$,CH( 20) , 

005630  AT  (09,42),  FAC(  REX(8i) )  ,StiriTLl$,CH(  20) , 

005650  AT  (12,22), 

005670  "Starting  word  =", 

005690  AT  ( 12,42)  ,PAC(  riEXf  81) ) ,  STAR  TPrlS ,  CH(20), 

005710  RANGE  (  *!  "  ,  'ittitittUtt' ) , 

005730  AT  (13,22), 

005750  "Ending  wdrd 

005770  A C  (13,42),  FAC( HEX( 81 ) ) ,  ENOPHf,  Crf( 20) , 

005790  RANGE  (  *  ,  •££&£££&£&*), 

005810  AT  (14,22), 

005830  "Lines  per  page  =*, 

005850  AT  (14,42),  FAC(HEX(82) ) ,  LPP%,  PIC(|#), 

UUD8 /U  AT  ( i/,22) , 

005890  "Print  at  ( TERM  INAL/ PRINTER)  =*, 

005910  AT  (17,53),  FAC(rtBX(8U),  TP$,  CH(08), 

005930  AT  (21,32), 

005950  "Press", 

005970  AT  (21,38),  FAC( rfEX( 85) ) ,  ENTERS,  Cri(05), 

005990  AT  (21,44), 

006010  "to  print", 

006030  AT  (22,24), 

006050  "Press", 

0060/0  AT  (22,30) , FAC( REX( 85) ) , PF14$,CH( 04) , 

006090  AT  (22,35),  “to  select  new  attrioutos", 

006110  AT  (23,19), 

006130  "Press", 

006150  a:  (23,25),  r AC( 0EX( 84 ) ) ,  PF15$,  CH(04), 

006170  AT  (23,30)  , 

006190  "to  select  another  Teclrucal  Word  List", 

006210  AT  (24,17), 

006230  "Press", 

006250  M  (  24,2  3),  FAC(  KEX(  84) ) ,  Pr'16$,  Cri(04), 

006270  AT  (24,28), 

006290  "to  return  to  tiie  Teclrucal  Word  List  Menu", 

006310  KEYS(aiN(0)&i31N(  15)6dIN(  16)  W3IN(  31) &BXN(  32)idIN(  14)6B1N(  30)  ) , 
006330  'ON  (BIN(  15)S,i3IN(  Jl)6i3IN(  16)S.8IN(  32)S3IN(  14)43IN(  30) )  GOTO  NEW, NEW 
006350  , EXIT, EXIT, *ES, YES 

006370  IE  STR(TP$,1,1)  =  *P"  X'tiEN  WEXTil 

006390  IF  S  TR(  TP$,  1,1)  O  "  T"  X8SN  TERM  PR 

006410  NEXi’ll:  IF  LPP*  <  51  THEN  NEXT! 3 

006430  ER$="*  Lines  per  page’  can  oe  at  most  50." 

006450  GOP)  PRINTSCR 

0064/0 

006490  I  JERRI:  PRINT 
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006510 

006530 

006550 

006570 

006590 

006610 

006630 

006650 

006670 

006690 

006710 

006750 

006770 

006790 

006810 

006830 

006850 

006870 

006890 

006910 

006930 

006950 

006970 

006990 

007010 

007030 

007050 

007070 

007090 

007110 

007130 

007150 

007170 

007190 

007210 

007230 

007250 

007270 

007290 

007310 

007330 

007350 

007370 

007390 

007410 

007430 

007450 

007470 

007490 

007510 

007530 

007550 

007570 

007590 

007610 

007630 

007650 


PRINT  dELL,HEX(94) ,ERRiS 
CLOSE  #1 

FOR  1=1  TO  200000  .‘NEXT  I 
GOTO  FILMNd 

TERMPR: 

ER$=”  Print  at  ‘  has  only  legal  values  TERMINAL  or  PRINTER.* 
GOTO  PRINTSCR 


REX:  £R$=" 

GOTO  PRINTSCR 


•Starting  word1  comas  alter  ‘Ending  word'.’ 


IOERR2:  PRINT 

PRINT  HEX{ 94) , “Error  occurred  oil  file  ";  PILES 
PRINT  HEX(94) , “Error  code  =  “;  FS(fl) 

STOP  "Touch  ENTER  to  return  to  menu.* 

GOTO  CWMENU 

NEXT13:  IP  STARTPH$=*  FIRST*  OR  ENDPil$=* LAST"  THEN  PORD 
If*  STARTPHS >ENOPH$  THEN  REX 

/*  Now  it's  time  to  generate  our  print  file  name  V 

PORD :  DAT$=  DATE 

D$=  STR ( DATS , 3 , 2 ) & ’ /" &STR ( DATS, 5,2) &“/" SSTR ( DATS ,  1 , 2 ) 
TS=  STR(  TIME ,  1 , 2 )  S."  :  ’ S.STR(  TIME ,  3 , 2 ) 

PPILES=“TATRia|#“ 

U=0 

NEXT14 :  CONVERT  U  TO  STR( PPILES,7,2) ,PIC(0U) 
l%=Ii*l 

CALL  “LIMITS'  (  PPILE$,SLIS$,3vOl4, CODES, MSGS) 

IP  CODE$="Y“  THEN  NEXT14 

DISPLAY 

AT  ;01,U3), 

"CRES:  Print  oy  Attr route  Suusystem" , 

AT  101,61) , 

"(Generation  Screen)", 

AT  (02,03) , 


AT  (  12,23), 

"Output  file  now  being  generated!" 

OPEN  NOGSTPARM  *2,OUTPUT,FILE=PFILE$,LiaRARY=SLI3S, 
VOI  AJME=SVO[  s ,  SPACE=  1 5000 
OOSUd  ITL_PGE 

IP  STARTPHS  =  "FIRST"  THEN  STARTPHS  =  ALL(HEX(00)) 
IP  ENDPHS  =  "LAST"  THEN  ENDPHS  =  ALL(H£X(PF)) 

PAG El  =  1 
RECS%  =  1 

READ  *1,  KEY )  =5  TAR TPHS ,  IOtWPFS 
IP  STR(  IOBUFFS,  1,20 )>  ENDPHS  THEN  HOME 
IP  STR( IOBUPPS, 1 , 16)  =*  TECHNICAL  HORDS"  THEN  AGAN 
KNOT:  IP  RTPLOi  THEN  7630 

IP  STR(I0dUFFS,26,i)O"‘"  THEN  AGAR 
PSN=  post  “JVCjNOInAP6a’=  STRi  xoauppS,  21 ,  i )) 

IF  T$(PSN)  =  "X"  THEN  7790 


107 


•  \  "V" >  ■>  ' jvv  vv.v ri'.v- wv^.  r.  ’ 


Technical  Report  86-001 


. 

*>; 


Waii'3  VS  Integrated  Editor  -  Version  6.10.00  14:56  11/13/84 

Input  File  is  CRESOTPA  in  Library  CRESOSOC  on  Volume  CRES02 


Page 


AGAN 


007670 
007690 
007710 
007  /JO 
007750 
007770 
00/790 
007810 
007830 
007850 
007870 
007890 
007910 
007930 
007950 
007970 
007990 
008010 
008030  BUG: 
008050 
00d0/0 
008090 
008110  BAG : 
008130 
003150 
0081/0 
008190 
008210 
008230 
008250 
0082/0 
008290 
008310 
006330 
008350 
008 t/0 
308390 
303410 
31)94)0  HERl 
003450 
903470 
00:3490 
095310 
006530 
0  J635U 
0035/0 

008590 
OOddll) 
008630 
009650 
0086/0 
008690 
003/10 
00d730 
008750 
008/ 70 
008790 


RT 

or 

RT 

nr 

rt 


RT 


HQ1E 


0ER: 


IF  T$( 14 ) =STR( IOBUFF$, 22, 1 )  THEN  7790 
IF  TS( 153  =3TR( IOBUFFS, 24, 1 )  THEN  7790 
IF  T$( I6)=STR( IOBUFFS, 23,1)  THEN  7790 
IF  rS(17)=Sm(10BUFF$,27,l)  THEN  7790 
IF  RTFL=2  AND  STR( IOBUFFS, 26, 1)="*"  THEN  7790 
GO  ID  AGAN 

IF  RECS'i  =  1  THEN  GOSUB  HEADER 
IF  SrR(TP$,L,l)="T*  THEN  BUG 
WRITE  #2,  USING  IMG6,C$,  "  * ,STR( IOBUFFS, 1, 20) , 

A£  ( ESN )  ,S'TR!  LOdUc't'i  ,22,1),  STR  !  IOBUFFS  ,24,1), 

S  TR( IOBUFFS, 23, l) , STR! IOBUFFS, 27 , 1 ) 

IF(STR( IOBUFFS, 26, 1)0“*' )THEN  BAG 
IF  RTrL<>0  THEN  BAG 
CS=HEX( 0000) 

WRITE  #2,  USING  IMG9,  CS, STR! IOBUFFS, 1, 20) 

WRITE  #2,  USING  IMG9,  CS,STR( IOBUFFS, 1 ,20) 

C£=HEX( 0001 ) 

GOTO  BAG 

IF  STR( IOBUFFS, 26,1)=***  THEN  STR! IOBUFFS, 26, 1 ) =*+* 

WRITS'  #2,  USING  IMG6,C$,STR(  IOBUFFS, 26, 1)  ,STR(  IOBUFFS,  1, 20) ,  1 
A$ ( PSN ) , STR ( I03UFFS , 22 , 1 ) ,S  TR ( IOBUFFS ,24,1),  i 

STR( IOBUFFS, 23,1), STR( I03UFFS,27, 1)  RT 

RECS  %  =RECS% + 1 

IF  RECS%>LPP%  THEN  RECS%=1 
IF  RSCSt=i  THEN  PAGEi-RAGEiti 
READ  11,  IOBUFFS, EOD  GOIO  HOME 
IF  STR(  IOBUFFS, 1,20)>ENDPH$  THEN  HOME 
GOTO  KNOT 

IF  RECS*=1  THEN  RECS%=51 
WRITE  12,  USING  TIT,  C£ 

REC3'*=RECS4*2 
WRITS  |2,  USING  DG,  CS 
FOR  I  =  RECS%  TO  LPP%il 
WRITE  #2,  USING  ITT,  CS . 

NEXT  r 

IF  STS(TPS,1,1)=V"  THEN  HER  1 
WRITE  12,  USING  ING8,  CS 

GOTO  HER 

IF  RTFLOO  THEN  HER:  WRITE  |2,  USING  RT,  HEX(U002) 

C$=HEX{ U00U ) 

FOR  1=1  TO  2 

WRITE  #2,  USING  RT1 ,  OS 

NEXT  i 

C$=HEX!  000 l ) 
close  #2 

IF  S  TR(  It'S,  i ,  1 )  -"P“  THEN  FIlSS 
CWSS  WS 

MSG2S  -  “cancel  Processing" 

MSK$=HEXi00) 

CMSGS  =  "  " 

CALL  *  LINE"  AJDH!  "DISPFILE" ,  “p“  ,Ri,I3$,RVOlS,  3k , Pr  ILE$,  JM 

SUSljdWli,  *C"  ,rtSG2$,  27%, "H"  ,MSK$, CMSGS, 255%, C%,R%)  JM 

ERS  =  “  “ 

IF  CtOO  OR  R*OU  ! 

THEN  ERS  =  S  TR  ( CMSGS  ,141) 

■  /  P)  l.'WOiTJJ 


v  M 


H 


!  U8 
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008010 
008830 
008850 
008870 
008880 
008810 
008930 
008950 
008970 
008990 
009010 
009030 
009050 
009070 
009090 
009110 
009130 
009150 
009170 
009190 
009210 
009230 
009250 
009270 
009290 
009310 
009330 
009350 
009370 
009390 
009410 
009430 
009450 
0094 /0 
009490 
009510 
009530 
009550 
009570 


MESS:  ER$»*  File  "&PPILE$&*  in  I.iDrary  "8.  SLIB$  &* 

SVOL$  &’  generated.* 

GO  DO  BALONEY 

NEW:  PRINT  PAGE,  AT( 12,28) ,HEX(84) ;*Closing  last  Erie" 

FOR  1=  1  TO  50000  ‘.NEXT  I 
FILE$=*  * 

CLOSE  fl 
GOTO  AGAIN 

TTL_PGS: 

C$=8EX(8001) 

WRITE  #2,  USING  TIT,  C6 
C$  =  HEX( 0012) 

WRITE  |2,  USING  TIT,  C$ 

C$  =  HEX(OOOl) 


WRITE 

•  2, 

USING 

TIT1, 

a 

WRITE 

12, 

USING 

TIT2, 

c$ 

WRITE 

#2, 

USING 

TITO, 

c$,D$,n 

WRITE 

12, 

USING 

ITT3, 

c$ 

WRITE 

»2, 

USING 

TIT2, 

c$ 

WRITE 

*2, 

USING 

Tin, 

c$ 

WRITE 

#2, 

USING 

T1T2, 

c$ 

IF  SB  TITLES  =  * 

*  THEN  GERRY 

WRITE 

12, 

USING 

TIT4, 

c$. 

SBTITLED 

IF  SBTITLIDO* 

"  THEN  WRITE  *2 

TIT10,  C$,  SBTITLlS 

WRITE 

12, 

USING 

TIT2, 

c$ 

GERRY :  WRITE 

#2, 

USING 

TIT5, 

c$. 

FILED 

WRITE 

#2, 

USING 

TIT2, 

c$ 

WRITE 

#2, 

USING 

TIT6, 

C$, 

LI  8$ 

WRITE 

#2, 

USING 

TIT2, 

c$ 

WRITE 

#2, 

USING 

TIT7, 

C$, 

IVUL$ 

WRITE 

*2, 

USING 

T1T2, 

c$. 

WRITE 

*2, 

USING 

TIT8, 

C$, 

STARTERS 

WR I  TE 

»2, 

USING 

TIT2, 

c$ 

WRITE 

#2, 

USING 

TIT9, 

c$. 

ENDPiit 

FOR  1=  1  TO  17 

IF  T$(I)="X*  OR  T$(  [)="*"  THEN  FIRS  TAT 


on  "i  : 


USING  : 


0U959U  NEXT  I 

0U9610  FIRSTAT:  WRITE  12, USING  TH’2,C$:  WRITE  #2, USING  TII'II, C$,A$(IJ 
009630  FOR  K=  IU  TO  17 

UU9b50  IF  T$( K) ="X"  OR  T$(K)=**"  THEN  WRITE  |2,  USING  TIT12,  C$,A$(K) 

009670  NEXT  K 

009690  WRITE  K2,  USING  TIT2,  C$ 

009710  WR  r  TE  #2,  USING  TIT! ,  C$ 

009/30  RETURN 

009750 

009770  HEADER: 

009/90  IF  PAGE*=i  THEN  FIRST 

009810  C$  =  HEXlOOOl) 

009830  IF  STR(  Tp$ ,  1 , 1 )  =" P"  THEN  FRST1 

009850  WRITE  *2,  USING  TIT,  CS 

009870  WRITE  |2,  USING  IMG8,  C$ 

009390  GOTO  FIRST 

009910  FRST1:  IF  RTFL<>0  THEN  FIRST 

009930  WRITE  <2,  USING  RT,  HEX! 0002) 


JM 

JM 
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009450 
009370 
009990 
010010 
010030 
010050 
O10070 
010090 
010110 
010130 
010150 
010170 
010190 
010210 
010230 
010250 
010270 
010290 
010310 
010330 
010350 
010370 
010390 
010410 
010430 
010450 
010470 
010490 
010510 
010530 
010550 
010570 
J10590 
010510 
110630 
0 1 1)650 

noo7  o 

1  ,  O', 4|) 

0 1  o ,’ !  o 
010/  30 
010750 
010//0 
010  790 
010310 
010330 
010350 
010870 
010890 
010910 
010930 
010950 
010970 
010990 

Olio  10 

011030 

011050 

011070 


ct»usx(uuuu) 

EOR  1=1  03  2 

WRITE  #2,  USING  KOI,  C$ 

NEXT  1 

first:  cs  =  next  8001) 

WHITE  #2,  USING  Oil’,  C$ 

C$  =  HEX(OOOl) 
if  sanrLES  =  * 

THEN  WHITE  #2,  USING  IMG,C$,D$,T$,PAGE% 

ELSE  GOOD  fOUT 
GOTO  ALRITE 

POUT:  WHITE  #2,  USING  IMG1, C$, SdTITL£$, D$,  TS, PAGE* 

IE  SBTITLISO* 

THEN  WHITE  #2,  USING  IMG7,  C$  ,St3TI  TL1$ 

A1HITE:  WHITE  #2,  USING  IMG2,  C$,  PILES,  LI3$,  I\X3L$ 
WHITE  12,  USING  IHG3,  C$ 

WRITE  |2,  USING  IMG4,  C$ 

WHITE  #2,  USING  1MG5,  Cf 
WRITE  #2,  USING  IMG3,  C$ 

RETURN 

Tiro:**#  :  m>  mi 

imi#  : 

TIT:  %H 

IXGMI  111  END  of  uisriNG  Ill 

rxri:  «,**  : - 


TIT2:%M 

TI  T3:  %l  I 

* 

IIT4:%II 

MM 

TI  1'5:  %M 


TI  To:  Ml 


TI  T 7:  Ml 


******  TECHNICAL  WORD  LIST  **** 


TH'uE  Of  LIST:  IIIMIMMMHM 


INPUT  RILE: 


MMMM 


INPUT  nldRARV:  MMMM 

INPUT  VoGJME:  HMH 


TIT6:MI  :  STARTING  WORD:  IHHHHIHHH 

mm  : 

TIT9:MI  :  ENDING  WORD:  HMMMMMMM 

it«i  : 

PI  Til)  :%M  I  IMMMMMMM 

Min  : 

TITil:MI  I  AlTKldUTES  SPECIFIED:  MMMlM 

iiimi 

TIT12:  Ml  I  MMMlM 

MMM  1 

IMG: Ml  MMMM  Mill 

PAGE  IMM 

IMG1 :  %||  nri,E  Of  LIST  :  HMMMMMMM  MM  MMMM 

HIM  PAGE  IMM 

IMG’:  MM  MMMMMMMMMM 

IMG2:  III  Input  file  is  MMMM  in  l.inrar/  MMMM  on  Volume  Ml 

III 

I  MG  3 :  %  1 1  — ==  ===  =  =  ^  =  ===*=  *=  ==-  =  =  =  =  ^  =  =  = 


MMMMMMMM 


IMMMMMMM 


ATTHiaUTES  SPECIFIED:  MMMlM 


IIHHIH 


E 


V.  ‘W-V 


v/vvwi^, 
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Input  File  is  CRES^TPA  in  Library  CRESgSRC  on  Volume  CRES02 


011090 

:=S333ax333=ai=3===:=3 

011095 

IMG4:%II 

WORD 

Part  of 

Past 

To  Be  n:  rt 

011100 

egat i ve 

Mand.  Tech. 

RT 

011105 

IMG5:%#» 

Speech 

Participle 

:  rt 

011110 

Word 

RT 

011115 

IMG6:%#» 

I  it################## 

MHIIOII 

1 

»  :  RT 

011120 

§ 

1 

RT 

01L210 

IMG9 : %## 

#################### 

011230 

IMG8:»i# 

+  =  ROOT  WORD 

011250 

RT:%i» 

BOLDFACE  =  Root  Word 

011270 

011290 

RTi:*<# 

BOLDFACE 

011310  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  »/ 

011330  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  V 
011350  DEF  FN*7{MSG$,a$,C$,D$) 

011370  PRINT 

011390  Mj=HEX( 94 ) 

011410  G$=B$ 

011430  L$=C$ 

011450  V$=D $ 

011470  RETURN 
011490 

011510  EXIT:  CLOSE  #1 

OU530  OUT:  /*  REIURNING  TO  TECHNICAL  WORD  LIST  MENU  */  JM 


CRES0WSL  in  library  CRES@PRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  Create/Maintain  Word  and  Phrase  Substitute  Lists 
Subsystem.  It  enables  the  user  to  select  by  PF  key  among  options  to 
create/maintain  the  Word  Substitute  List  or  the  Phrase  Substitute  List,  to 
print  the  Word  Substitute  List,  the  Phrase  Substitute  List,  or  a  combined  Word 
and  Phrase  Substitute  List,  or  to  return  to  the  CRES  Master  Menu. 


A  complete  listing  follows. 


Technical  Report  86-001 


Wang  VS  Integrated  editor  -  Version  6.10.00  16:12  11/13/84  Page 
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PROCEDURE  CRES  SUBSTI  TUTION  LIST  MENU 

AUTHOR  ROSE  TANK 

DATE  10/06/83 

Aostraot:  This  procedure  is  a  subsystem  ot  ORES  Master  Menu 
(option  3  -  Create/Maintain  Substitution  Lists). 

It  allows  the  user  to  select  and  run  any 
substitution  list  file  option. 


DECLARE  MJSERINPT  AS  INTEGER  INITIAL 
DECLARE  4OPTI0NERR  AS  STRING  (79)  INITIAL 
DECLARE  &OPTIONERR2  AS  STRING  (79)  INITIAL 
DECLARE  &USERNAME  AS  STRING  (24)  INITIAL 
DECLARE  &ERRMSG  AS  STRING  (34)  INITIAL 
DECLARE  5.RUNLIS  AS  STRING  (8)  INITIAL 
DECLARE  (.RUNVOL  AS  STRING  (6)  INITIAL 


EXTRACT  fcUSSRNAME=USSRNAMH,  &RUNLIBOUTLI8,  &RUNVDL=RUNVOL 

CENTER 


JM 

JH 

JM 


Gt'TUSERINPT:  PROMPT  PERSE  =  &USERINPT 

DIM  "CRES:  Suostitution  Suosystem 
tution  Menu  Screen)*; 

DIM  "=========—===—============= 


(Suosti  RT 
RT 


S353  =  S3S:3»aaa33Sa 

.  «  «  . 


DIM  " 

DIM  *  Use  the  appropriate" .BRIGHT 
red  operation."; 


PE  Key","  to  select  the  desi 


DIM  "  V 
DIM  " 
LINE  " 
DIM  "  * ; 


".LINE  "PE", DIM 
Operation 


000100 

000200 

000300 

000400 

000500 

000600 

000700 

000800 

000900 

001000 

001100 

001200 

001300 

001400 

001500 

001600 

001700 

001800 

001900 

002000 

002100 

002200 

002300 

002400 

002500 

002600 

002700 

002800 

002900 

003000 

003100 

003200 

003300 


DIM  " 

", BRIGHT  *  17 , " 

-  Cieate/Maintain  Word  Suosti 

003400 

tution  List"; 

003500 

DIM  ’ 

", BRIGHT  *2*," 

-  Create/Maintain  Phrase  Suos 

003510 

titution  List"; 

003520 

DIM  " 

", Bright  “3",* 

-  Print  Word  Substitution  Lis 

003600 

t"; 

003700 

DIM  " 

*,Brignt  "4",* 

-  Print  Phrase  Suostitution  L 

003730 

1st"  ; 

003740 

DIM  " 

", Bright  "5"," 

-  Print  Como i nation  of  Word  a 

003750 

nd  Phrase  Substitutes"; 

003760 

DIM  "  *  ; 

003800 

DIM  " 

"  .Bright  "16"," 

-  Return  to  CRES  Master  Menu’ 

003900 

;  DIM  "  " ;*  *  ;"  *  ;"  " ; 

,  m  i  , 

004000 

BRIGHT  WPTIONERR; 

004100 

BLINK  &OPTIONERR2; 

004200 

* 

004300 

ASSIGN 

&ERR14SG  =  "  " 

004400 

ASSIGN 

&OPTIONERR  =  "  " 

004500 

ASSIGN 

yosnotiWAi  =  *  * 

004600 

004700 

IE 

&USSRINPT  E-J  lb 

GO  I'D  USEREX1T 

0043UO 

IE 

MJSERINPT  EQ  32 

GO IV)  USEREXIT 

004900 

IE 

&USERINPT  EQ  1 

GOTO  RUNWSL 

005000 

IE 

&USERINPT  DJ  17 

GOI O  RUNWSL 

005100 

lib 
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if  wserinpi'  eq  2 

GO  IV) 

RUNPSL 

005110 

IF  SSSSRINPr  EQ  18 

GOTO 

RUNPSL 

005120 

IF  S.USERINPT  EQ  3 

GOTO 

RUN PUS 

RT 

005200 

IF  S.USERINP1’  BQ  19 

GOTO 

KUNPWS 

RT 

005300 

IF  &USERINPT  EQ  4 

GOTO 

RUNPPS 

005330 

IF  &USERINPT  EQ  20 

GOTO 

RUNPPS 

005340 

IF  &USF.RINPr  EQ  8 

GOTO 

RUNCWP 

005350 

IF  &US£RIN?r  EQ  21 

GOTO 

RUNCWP 

005360 

005400 

ASS IGN  &OPTIONERR  = 

"I'm  sorry,  out  your  selected 

option 

005500 

is  aoc  < 

surrently  available.* 

005600 

ASSIGN  WPTIONERR2  ; 

=  "Please  select  another  topic. 

m 

005700 

GO1  IV)  GETUSERINPr 

005800 

* 

005900 

rfJNWSL: 

HON  CR£S@WSL  IN  &RUNLI3 

ON  iHUNVOL 

006000 

IF  RUNWSL  EQ  0 

GOTO  GETUSERINPr 

006100 

GO IV)  JSEHEXir 

006200 

k 

006300 

R'JN  PUS: 

RUN  CRESWSP  IN  &RUNLI8 

ON  &RUNVOL 

RT 

006400 

IF  HUNPWS  EQ  0 

GOTO  GETUSERINPr 

RT 

006500 

GOTO  JSEREXir 

006600 

* 

006710 

RUNPSL: 

RUN  CRESi^pSL  IN  &RUNLIB 

ON  &RUNVOL 

006720 

IF  RUNPSL  EQ  0 

GOTO  GETUSERINPr 

006730 

GO IV)  USEREXIT 

U06740 

* 

00C750 

RUNPPS: 

RUN  CRES@PSP  IN  &RUNLIB 

ON  &RUNVOL 

006760 

IF  RUNPPS  EQ  0 

GOTO  GhTUSER  INPT 

006770 

09 TO  USEREXIT 

006780 

k 

006782 

RJNCWP: 

RUN  CRES@SBP  IN  WIUNLId 

ON  &RUNVUL 

006784 

IF  RUNCWP  F,Q  0 

GOTO  GETUSERINPr 

006786 

GO I’J  USEREXI I' 

006788 

* 

, 

006790 

ussrsx  i  r 

:  RETURN 

006UUU 

I 
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CRESOWSL  in  library  CRESOSRC  is  the  BASIC  language  program  to 
create/maintain  the  Word  Substitute  List.  The  object  language  version  is 
CRESOWSL  in  library  CRESOSAV . 

This  program  first  allows  the  user  to  rpecify  the  Word  Substitute  List  to 
be  created  or  maintained.  Then,  the  program  enables  the  user  to  add,  delete, 
or  modify  any  given  word  and  its  substitute( s)  and  attributes.  Up  to  two 
substitutes  can  be  specified.  The  first  substitute  can  contain  up  to  ZO 
characters;  the  second  substitute  can  contain  up  to  15  characters. 

The  only  characters  accepted  in  the  input  word  and  its  substi tute( s )  are 
the  letters  A  through  Z,  and  There  can  be  no  embedded  blanks. 

The  data  record  for  each  word  also  contains  information  about  the  word's 
attributes:  the  part  of  speech  (see  table  1),  the  past  participle  flag,  and 
the  negative  flag.  A  complete  data  record  description  is  provided  in  appendi 
A. 


There  is  a  protection  system  implemented  for  this  list,  and  the  program 
makes  provision  for  clearinq  the  protect  bytes,  if  for  some  reason  the  bytes 
nave  been  left  set  incorrectly. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart. 


Technical  Report  86-001 


Wang  VS  Integrated  Editor  -  Version  6.10.00  16:06  11/13/64  Page 

Input  P 1 1  e  is  CRF.S@WSL  in  Linear/  CRESOSRC  on  Volume  CRES02 

000010  /*  i' hi s  is  t  lie  CRKS  WORD  SUBSTITUTION  MAINTENANCE  SUBSYSTEM  V  RT 

000110  /*  */  RT 

000210  /*  AUTHOR:  Rose  Tan*  */  JM 

000310  /*  Date:  Octooer  12,  1983  */  RT 

000410  /*  */  RT 

000610  RT 

U00610  /*  Tne  rol lowing  caxde  sets  up  a  screen,  which  asks  for  the  */  RT 

000710  /*  name  of  the  file  containing  ttie  Word  Sul>.  list  that  is  */  RT 

000810  /*  to  oe  modified.  It  also  provides  the  opportunity  co  change  */  RT 

000910  /*  tne  liurar/  and  voiuine  names  wruch  are  set  to  tne  appro-  */  RT 

001010  /*  pnate  defaults  through  tlxi  "Extract"  system  routine.  V  RT 

001110  RT 

001210  RT 

001310  DIM  NURD$20,ERRl$50,eODE$l,MSG$50,F$40,G$l,PRQTECT$3  RT 

001410  DIM  F 1$2Q ,  IOBUFFS61 , ER1S50 ,XYZ$1 ,M£SSG$21, P$(13)3,FIL$22  RT 

001610  DIM  PFK$  4 ,  TABS  3 ,  Q  TABS  7 ,  F 1 1  ,E$8 ,  US  ER$  3 ,  PR  1  $  3 ,  USERNAMES  2  4 ,  WRK.9TS  3  RT 

001610  DIM  LIBS  08,PASSWRD$13,X$1  JM 

001710  DIM  IVOL$  06,rtEADERS50,LSl,V$i,B$l,C$l,DSl,MSl  RT 

001810  DIM  MOOS  1 6 , SUBONES 20, SUBIVJQS 16, PPP L$  1 , PR'IOS PCS  1  RT 

001910  DIM  DBFS  '  07 , NEGPLSl  RT 

002010  DIM  LEGS  06, A6S10,A7S7  RT 

002110  DIM  NOEXISTS68,  ESI  RT 

002210  DIM  ERS  68  RT 

002310  DIM  3 APS 26  RT 

nnoi  i  n  cn.i^t'T'nvr'TfVj  M \ T  \T S333Y3 9? 

002610  FILS  “"Word  Substitution  List"  RT 

002610  MESS'JS-'Parts  u£  speech  cedes"  RT 

1)02710  TAA$="  TAB"  :  f)!’AB$="  BACK  TAB"  RT 

002810  P$(1)="(J)":P$(2)  =  "(  j  )*:?$(  3) =*  ( A) " : P$( 4 )=" (a) " : ?$( 5)  =  " (B) "  RT 

0039 10  PS!  6)  -  " (  C) " :  i'Si  7)  =  "  (  PS(  8) -" (N) *: PS( 9)  ="( n) “: PS(  10 )="(  P) "  RT 

003010  P$( 11)="  (O)" :P$(  1 2 ) =  * ( V ) " :P$( 1 3 )  =  “  ( d )  *  RT 

003110  ITLE8S  =  *PARr_a-_6PSECH"  JM 

00  3210  1 TLE6S  T  ‘  DBF  IN  1  TltXI"  JM 

no  mo  ENTERS  =  "  ENTER"  ,  RT 

003410  P.-'lS-'iVI"  :  P.-i6S=*PFlo"  RT 

00)610  RT 

0036 10  F lS=:iEX(  A0 1 4A0 1 4A0UF A00 1 A00 1 A00 1A00 300  i  1)  RT 

0  J  J 7 10  FS-  ‘Filename  net  found  on  ( liurar// /uluii.e) . "  RT 

00)610  ERR  IS  *  T/.'i  ER.R.iR  -  Please  oitec*  filename  and  rospeoiC/."  RT 

Oil  1*1  )  RT 

0040  L)  CAL.,  ".-.XTRAC."  AJDHi *  ID* , JSERS, ‘ 1L* ,Li3$, *  IV" , 1VULS)  JM 

non  in  df  J  rt 

ou *210  FrLES="«’RDS.)n;r*  jm 

004310  ALAIN:  GS'sHSXi  81 )  RT 

004410  MSGS-*  ’ : u$-HEXl  81 )  RT 

OOisiO  .■$=;!;•:.<(  8  i  ) :  MS 'HEX  i  80)  RT 

004810  RT 

004710  /  ;.,MN0  :  RT 

004810  AtVEPT  !  RT 

004  M0  AT  ;n.,01  ),  :  RT 

OOoOIO  'OREL:  Nerd  da:>, it Ltut len  List  Maintenance  Suos/stem",  !  RT 

00 all 0  AT  (01,67),  1  RT 

OitSii*)  "  1  E ;  1  •-*  O-O-vr  ion  Screen)’,  1  RT 

JJoJlJ  AT  (02,01),  RT 

OOV,:  '  *  -  -----  ----  =  -===-==  =  =  ,  =  . .  =  RT 

008-ji  i  ,=„=-„===»===",  :  rt 

O'O',.,;  '  AT  (04,  12),  :  RT 
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005710  "Welcome  to  tne”, 

005810  AT  (04,27),  FAC( HEX( 8b) ) , 

005910  HEADERS, 

006010  AT  (07,06), 

006110  “Please  specify  the", 

006210  AT  (07,25),  FAC( HEX( 84) ) , 

006310  FILS, 

006410  AT  (07,48), 

006510  “you  want  to  modify  or  create.", 

006610  AT  (13,30), 

006710  “File  =", 

006310  AT  (13,43),FAC(G$) , FILES  ,  CH(08), 

006910  RANGE  (  ) , 

007010  AT  (14,30), 

007110  "Library  =", 

007210  AT  ( 14,43) ,FAC(  L£) ,  LIBS  ,  CHIOS), 

007310  RANGE  (  ')  "  ,  •£&&&&&?), 

007410  AT  (15,30), 

007510  "Volume  =“, 

007610  AT  <(15,43), FAC(VS),  IVOL$  ,CH(06), 

007710  RANGE  (  "1  "  ,  'UtUtUUU'), 

007810  AT  (18,24),  FAC(M$),  MSGS, 

007910  AT  (20, 30), "Press", 

008010  AT  (20,36) ,FAC( HSX( 84 ) ) , 

0081 10  ENTERS, 

008210  ATI  20,42), 

008310  “to  continue", 

008410  AT  (21,17), "Press", 

008510  AT  (21,23),  FAC( HEX( 84 ) ) , 

008610  PF16S, 

008710  AT  (21,28), 

008810  "to  return  to  the  Substitution  List  Menu", 

008)10  OS  ( 3IN(  16  )idIN(  32))  GOTO  OUT, OUT 
009110 

009210  /*  SET  OP  THE  USER  FILE  HlyOCK  */ 

009310 

009410  SELECT  #l,"WKDSUd",VARC,  INDEXED,  KECSI2B=80,KE2POS=1  ,KE'7lEN=20, 

009510  IOERR  GOTO  [OERR1 

009610 

009710  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  V 
009310 

009910  CALL  "LIMI TS" ( PILES, LI 3$, IVOL$,OODE$,MSG$) 

010010  IF  CODE$=*Y"  THEN  GOTO  222 
010110  IF  CODES ~"N*  THEN  CREATE 

010210  IF  a)DE$=*V"  THEN  GOS Jd’  /( STR( MSGS, 3 ), IIEX(  81 ), HEX(  81 )  ,HEX(  91 ) ) 
01U310  IF  CODE$="L"  THEN  ODSOd1 7( STR(MSG$, 3) ,HEX( 81 ) ,HEX(  91 ) ,HEX(  81 ) > 
010410  IF  CODE$=’E"  THEN  vlOSJi)'  7(STR( MSGS,  3)  ,HEX(  31 )  ,HEX(  8 1 )  ,HEX(  Hi )  ) 
010510  GOTO  FILrtNU 
010610 

010710  /*  rF  WE  FAI.L  HERE,  IT  MUST  HE  TIME  TO  OPEN  FILE  »/ 

010310  CREATE : 

010910  ACCEPT 

011010  "CRES:  Word  Sudji  nut  run  List  Maintenance  Subsystem", 

anno  at  ;oi,goj, 

011210  *( Create  File  Screen)’, 

011310  AT  (02,01) , 

0114)0  "  =  =  —  ^^==^=  =  ==  =  ====^==========^=======,===========-======= 
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011510  =.»==*=========",  1  RT 

011610  AT  (06,08),  1  RT 

011710  ‘The  file  you  have  selected  does  not  currently  exist  in  the  liorai  RT 
011810  ry",  I  RT 

011910  AT  (07,08),  !  RT 

012010  “and  volume  specified.  For  your  convenience,  the  following  are  *,!  JM 
012110  AT  (08,08),  RT 

012210  "the  parameters  you  suomitted.*,  I  RT 

012310  AT  (11,30),  l  RT 

012410  “File  =“,  RT 

012510  AT  (11,40) ,FAC( HEX( 85) ) , FILES  ,  CH(08),  1  RT 

012610  AT  (12,30),  1  RT 

012710  "Liorary=“,  RT 

012810  AT  (12,40),  FAC( HEX( 85) ) ,  LIBS  ,  Crf( 08) ,  !  RT 

012910  AT  (13,30),  RT 

013010  "Volume  =",  I  RT 

013110  AT  (13,40),  FAC(HEX(85)  ) ,  IVOL$  ,  CH{06),  RT 

013210  AT  (17,15),  RT 

013310  "To  create  a  new  file  from  these  parameters,  press",  1  JM 

013410  AT '(17,65),  FAC(  HEX(  85)  ) ,  Ei'TTERS  ,  CH(05),  i  RT 

013510  AT  (19,26),  I  RT 

013610  "To  select  anotner  file,  press’,  I  JM 

013710  AT  (19,56),  FAC(HEX(85) ) ,  PF1$  ,  CH(03),  RT 

013810  KEYS(BIN(0)S3IN(1)68IN(17)),KEY(OPTION),  !  RT 

013910  ON  ( BIN( 1 ) &BIN( 17) )  GOTO  FILMNU,FILMNU  RT 

014010  RT 

014110  OPEN  NOGBTPARM  II,  OUTPUT,  FILE=  FILES,  LIBRARY=LIB$,  !  RT 

014210  VOLUME3  IVOLS,  SPACE=1000  RT 

014310  lQ8Ue-e$=  "  WORD  SUBSTITUTION*  RT 

014410  WRITE  II,  IOBUFFS  RT 

014510  CLOSE  II  RT 

014610  ZZZ :  CAf.L  "REAOFOR"  ADDR( FILES, LIBS, IVOLS, 0%, "RS" ,RSIZ%,RET%)  JM 

014710  IF  RSIZ%060  THEN  Z Z1  JM 

014810  OPEN  NOGETPARM  II, SHARED,  FILE3  FILES,  LIBRARY  =  LIB$,  I  JM 

014910  VOLUME  3  IVOLS  RT 

015210  READ  II,  IOBUFFS  RT 

015310  IF  IOBUFFS3"  WORD  SUBSTITUTION"  THEN  YES  RT 

015410  CLOSE  |1  JM 

015510  ZZ1 :  MS«HEX(94)  JM 

015610  MSGS3  ERR1S  RT 

015710  GOTO  FILMNU  RT 

015810  YES:  RT 

015910  /*  This  section  of  code  generates  another  screen,  which  asxs  */  JM 

016010  /*  for  tne  particular  word  and  its  corresponding  operation  -  */  JM 

016110  /*  either  insert  word,  delete  word,  or  modify  word.  The  user  is  */  RT 

016210  /*  also  at  tnis  point  given  the  option  of  returning  to  the  */  JM 

016310  /*  Substitution  List  Menu,  if  desired.  */  JM 

016410  RT 

016510  ZAP$="PIease  select  the  word:"  RT 

016610  WORDS3"  “  RT 

016710  WORDEQ$="word  3  ’  RT 

016810  PFK$="  PF  “  RT 

016910  OPERS3"  Operation"  RT 

017010  0$="1"  RT 

017110  r$3"2':THS="J":Q4="14":RS="15":SS="16"  RT 

017210  ERS  ="  "  RT 

017310  SR1$="  "  ■  RT 
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017320  PASSWRD$=HHX(0O0i02030E0Fi011i2i3iElF2OJ  JM 

017410  MOEXIST$="The  word  you  are  attesting  to  modiiy  does  not  exist  in!  R r 

017510  this  list.’  RT 

017520  X$=HEX( 81)  JM 

017G10  £S=HEX(  84 )  RT 

01/710  RT 

017810  CWMENU :  RT 

017910  ACCEPT  !  RT 

018010  AT  (01,01),  !  JM 

018020  "CRES:  Word  Suostitution  List  Maintenance  Subsystem",  !  JM 

018110  AT  (01,59),  "(Word  &  Option  Screen)",  !  JM 

018210  AT  (02,01),  "=============================^===============!  RT 

018310  ===:=-  =  =  =  ^=======================",  !  RT 

018410  AT  (04,08),  FAC( H£X( 8C) ) ,  !  RT 

018510  ZAPS,  !  RT 

018610  AT  (06,28),  FAC( HEX  (80),  !  RT 

018710  WORDEJ$  ,  1  RT 

018dl0  AT  (06,36),  FAC(XS),  WORDS  ,  CH(20),  !  JM 

OlddlO  AT  (08,13),  FAC(  ES),  ERS,  !  RT 

019010  AT  '(09,16),  FAC(  E$),  ER1$,  1  Rl’ 

019110  AT  (11,08),  "To  cont!  RT 

019210  mue,  select  the  PF  Key  corresponding  to  the  desired  operation.",!  RT 
019310  AT  (13,30),  FAC( HEX( A5) ) ,  !  RT 

019410  ,  !  RT 

019510  AT  (13,38),  FAC( HEX( AC) ) ,  !  RT 

019610  OPERt,  !  RT 

019710  AT  (15,31),  FAC( HEX( 84 ) ) ,  !  RT 

019810  OS  ,  !  RT 

019910  AT  (15,39)  ,  !  Rl' 

020010  "INSERT  word",  !  RT 

020110  AT  (16,31),  FAC( HSX( 84 ) ) ,  !  RT 

020210  T$  ,  ’  !  RT 

020310  AT  (16,39),  !  RT 

020410  “DELETE  word",  ,  !  RT 

020510  AT  (17,31),  FAC( HEX( 84 ) ) ,  !  RT 

020610  TH$,  !  RT 

020710  AT  (17,39),  !  RT 

020810  "MODIFY  word",  !  RT 

020910  AT  (19,31),  FAC( HEX( 84 ) ) ,  !  RT 

021010  Q$,  !  RT 

021110  AT  (19,39),  !  RT 

021210  "Protection  Override",  !  RT 

021310  AT  (20,31),  FAC( HEX( 84) ) ,  !  RT 

021410  RS  ,  !  RT 

021510  AT  (20,39) ,  !  RT 

021610  "Return  to  Word  Substitution  List  Selection",  !  RT 

021710  AT  (21,31),  FAC( HEX( 84 ) ) ,  !  RT 

021810  S$  ,  !  RT 

021910  AT  (21,39),  !  RT 

022010  "Return  to  Suostitution  List  Menu",  !  JM 

022110  K  S'/S  (  PA3SWRDS )  ,  !  JM 

022310  KEy(OPflON)  JM 

022421)  IF  OPTION=*15  OR  OPTIJN=31  THEN  HEW  JM 

022430  IF  OPTION- 16  OR  OPTION=31  THEN  EXIT  JM 

022510  RT 

022610  FOR  r=l  ru  LEN(WORDS)  JM 

022710  if  posi " •  AdCi)EFr,nrjxr,'iNopj.«ajvwxy2-*=srR ( words, i , i ) )  =o  :  jm 


w. 
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i* 


022810  THEN  ILLERR  JM 
022910  NEXT  I  Jrt 
023010 

023110  E$=HEX(8D)  ST 
023210  £R$  =>"  "  RT 
023310  ER1$="  " 

023410  IF  (OPTION=0)AND(DP=i)  THEN  DEL  RT 
023510  IF  DF=1  THEN  UPDATE  Rr 
023610  IF  (OPTION=14)  OR  (OPriON=30)  THEN  OVERRIDE  RT 
023710  IF  STR(WORD$, 1,1)0  *  "  THEN  GOTO  REED  RT 
023810  RT 
023910  PRINT  SELL  RT 
024010  ER$="  The  first  character  cannot  be  blank."  RT 
024110  ER1$=  "  Please  reenter  the  appropriate  word  and  PF  key.*  RT 
024210  E$=  HEX( 94)  RT 
024310  GOTO  CWMENU  RT 
024410  RT 
024510  ILLERR:  JM 
024610  ER$=*“Iiiegal  character  found  in  word  -  please  reenter."  JM 
024710  Ei*=HEX(  94) :  GCTO  CWMENU  JM 
024810 

024910  OVERRIDE:  RT 
025010  IF  NF=1  AND  P't=i  THEN  CHX  RT 
025110  ER$="Please  cback  if  word  exists  first  by  selecting  an  option."  RT 
025210  E$=HEX( 84 )  RT 
025310  GOTO  C.1MENU  RT 
025410  Rf 
025510  CriK :  RT 
025610  IF  USER$=PROTECT$  THEN  REMOVE  RT 
025710  ER$=*  "you  don't  have  the  clearance  to  override  the  protect."  RT 
025810  EK1$=  "  *  RT 
025910  E$=  HEX(84)  RT 
026010  GOTO  CWMENU  RT 
026110  ,  RT 
026210  REMOVE:  PROTECT$=  "  "  :Pi=0  RT 
026310  READ  II,  HOLD,  KEY=WORD$, iOBUFFf  RT 
026410  $PACK  (F=F1$)  I08UFF$  FROM  W0RD$,  SU80NB$,SUaTWC>$,  RT 
026510  PR'T3SPC$ ,  PPt'lS,  NEGFL$ ,  PROTECTS  RT 
026610  REWRITE  #1,  IOBUFF$,  DATA  GOTO  IOERR2  RT 
026710  ER$=  ’  You  nwy  now  select  your  option."  RT 
026810  ERIS=>*  "  RT 
026910  E$-  HEX( 84 )  RT 
027010  GOTO  CWMENU  RT 
027110  RT 
027210  IOERR1:  PRINT  RT 
027310  Mi=HEX(94)  RT 
027410  MSG$=  ERR1S  RT 
027510  CLOSE  II  RT 
027610  GOTO  FILMNU  RT 
027710  RT 
027810  IOERR2:  PRINT  RT 
027910  PRINT  HEX(94), "Error  occurred  on  file  ";  FILE$  RT 
028010  PRINT  HEX! 94), "Error  code  =  FS(ll)  RT 
028110  STOP  "Touch  ENTER  to  return  to  menu."  RT 
028210  GOTO  CWMENU  RT 
028310  RT 
028410  REED:  IF  OPTIONOO  THEN  SRCH  RT 
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023310 
028610 
028710 
028715 
028720 
028310 
023910 
029010 
029110 
029210 
029310 
029410 
029510 
029610 
029710 
029810 
029910 
030010 
030110 
030210 
030310 
030410 
030510 
030610 
030710 
030810 
030910 
031010 
031110 
031210 
031310 
031410 
031510 
031610 
031710 
031310 
031910 
032010 
0  12  110 
0  12210 
032310 
0  32  320 
032410 
032510 
0  32610 
I)  12/10 
032310 
032910 
0 1 30 1 0 
033110 
033310 
033410 
0 13610 
033610 
033710 
033810 
0  3  34 1  0 


ER$=  * 

E$=  HEX( 94 ) 
GOTO  CWMENU 


Command  missing.* 


SRCil :  P%  =  1 

READ  #1 , HOlD,  RET  =1/JRD$ ,  IOBUFFS,  BUD  GOTO  NOTFOUND, 
DATA  GOTO  IOSRR2 


/*  OnpdCK  and  cheat  if  currently  ueing  modified  oy  another  */ 

$  UN  PACK  (  F=F1S)  IOBUFFS  'TO  WORDS,SUdONE$,SU8TW3$,  1 

PRTOSPCS , PPFLS ,  NEGFL$ ,  PROTECTS 
if  PRarocr$=  "  *  then  now 
CALL  " F 1  NOUSER"  ADDR(  PROTECTS, USERNAMES, WRKSri ) 

CONVERT  WRK.ST*  lO  WRK.3TS,  PIC(g|§) 

F$=  HEX  (94) 

EilS="  Surry,  "&  USERNAMES  St*  is  currently  edit ing  * 

'ERl$=*  1  *  t.  WORDS  &  " *  “ &  *  at  workstation  "s.  WRKSTS 

REWRI TE  11,  rOilUFFS 
GOTO  CWMENU 

NOW:  PROTF.CTS3  USERS 

SPACE  ( F=r  1$ )  lOdUFFS  FROM  WORDS,  SUdONBS,SU8'TNO$ ,  I 

PRTOSPCS ,  PPFTS ,  NEGFLS ,  PROTECTS 
REWRITE  #1,  lOdUFFS,  DATA  GOTO  IOERR2 

/*  NON  d RANCH  TO  THE  OPTION  SELECTED  */ 

OPT:  ON  OPTION  GOTO  1NSERT,DELET,M001F* 

ON  OPTION-16  GOTO  INSER  r,DSl,ET,MODIFy 

NOTFOUND:  NF=U 

GOTO  OPT 

INSERT: 

/*  NF=0  indicates  tie  word  doesn't  yet  exist  so  go  ahead  */ 
/*  and  insert.  NF=1  indicates  the  word  exists.  */ 

IF  NF=l  THEN  EXIST 
MluS  "(insert  Screen)" 

MESING$=*  inserting  word* 

SU130NE$ ,  SUd  TWJ$ ,  PRTOSPC$ ,  PPFLS ,  NEGFL$=  *  * 

PROTECTS  -  USERS 

SPACE  (  F  ■  F  1  $ )  IOdlJFFS  FRi)M  WOR.)$,  SUHONE$,SUH  IU)$ ,  ! 

PR  H  )S  i  Vlt ,  PPFLS ,  NEGFLS ,  PROTECTS 
NR  I  l‘E  #1,  lOdUFFS,  DATA  GOTO  IOERR2 
GOTO  INS 

/*  Coming  from  insert  with  the  word  currently  existing  */ 

EXIST: 

F.R$="  Tlx-1  word  &  WORDS  &  already  exists  in  ttus  list." 

E$  -  HEX( 94 ) 

REV)  1(1,  HOI..),  KEV -  W.)R,)$,  TOdUFrS 
PROTECTS3*  "  :  P%=U 

BRACK  (F--F1S)  DRUPES  FROM  NORD$,  SURONE$,SUdTNO$,  I 
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034010  PRTOSPC$,PPFL$,NEGFL$, PROTECTS  FT 
034110  REWRITE  #1,  IOOUFFS,  DMA  GOTO  IOERR2  RT 
034210  GOTO  CWMENU  RT 
034310  RT 
034410  DELET:  IF  NF=0  THEN  NODEL  RT 
034510  DF=1  RT 
034610  £R$=  "  Press  ENTER  to  confirm  deletion  of  "&  1K)RD$  RT 
034710  ER1$=*  or  press  PF14  to  cancel  the  deletion."  RT 
034720  X$=HEX( 84)  JM 
034730  PASSWRD$=riEX( 000E1E)  JM 
034810  ES»  HEX (94)  RT 
034910  GOTO  CWMENlI  FT 
035010  RT 
035110  DEL:  READ  #1,  HOLD,  KEYWORDS,  IOdUrYS  RT 
035210  DELETE  t 1  RT 
035310  DF=0  RT 
035410  ERS=  *  ‘  "&WOKDS&"'  deleted  -  Please  select  your  next  word."  RT 
035510  2AP$=*  "  RT 
035520  X$“HEX(  81)  JM 
035530  PA3SWRD$=HEX(000102030E0Fl01112i31EiF20)  JM 
035610  E$=  HEX(8C)  RT 
035710  WORDS*"  "  RT 
035720  NF=0  JM 
035810  GOTO  CWMENU  RT 
035910  RT 
OJbUIU  NODEL:  ERS="  i’ne  word  '"AvVJilDSi  "'  does  not  exist  in  this  list."  RT 
036110  E$=  HEX( 94 )  RT 
036210  GOTO  CWMrlMO  RT 
036310  RT 
036410  MODIFY :  IF  NF  =  1  THEN  GE IT  T  RT 
036510  ER$  =  NO  EX  IS  lit  /*  if  word  not  in  list,  */  RT 
036610  E$=HEX(94)  /*  set  up  message  and  fac  and  */  RT 
036710  GOTO  CWMENU  /*  go  oack  up  to  previous  screen  */  RT 
036310  ,  RT 
036910  GET  IT:  JM 
037210  RT 
037310  MJD$  “"(Modify  Screen)’  RT 
037320  MESING$="  modifying  word’  JM 
03/410  INS:  RT 
037510  DEF$  =" CURRENT"  RT 
037610  A5$  ="  ATTRIBUTES"  RT 
037710  LEGS  -"LEGAL"  RT 
037810  A  7$  “"ENTRIES"  RT 
03  7910  ERi$  ="  "  RT 
038010  XY2$  --HEX(SC)  RT 
033110  ERONINS:  RT 
038210  ACCEPT  '.  RT 
038310  AT  (01,01),  J  RT 
038410  "CRES:  Word  Substitution  List  Maintenance  Suosystem",  !  JM 
038510  AT  (01,66),  F AC ( HEX ( 8C) ) ,MOO$,  [  RT 
038610  AT  (02,01),  =  =  RT 
0  38710  “  =  =■*«=*==«==  .-  =  -.  =  «■,  .  RT 
038810  AT  (03,07),  •  RT 
033910  "For  an  explanation  of  legal  entries,  press",  I  JM 
039010  AT  (03,50) ,FAC( HEX( 84) ) ,  PF1$,  1  RT 
0391 10  AT  (03,54) ,  !  RT 
U 392 10  ottierwise,  enter",  ;  RT 
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Rage 


039310 
039410 
039510 
0396 10 
039710 
039310 
0  39910 
U40010 
040110 
040210 
040310 
040410 
040510 
040610 
040710 
040310 
040910 
041010 
041110 
041210 
041310 
04141U 
041510 
041610 
041710 
041310 
041910 
042010 
04211U 
042210 
042310 
042410 
042510 
042610 
042/10 
042310 
012910 
043010 
043110 
043210 
043311) 
1)4  1410 
043420 
04  3510 
04  3610 
043710 
04  3310 
043910 
04401U 
044110 
04 4210 
344310 
044410 
044510 
044610 
044/10 
04  4  ■)  10 


A T  (04,07), 

’the  appropriate  attribute!  s) .“ , 

AX'  (07,31) ,  FAC  (HEX  (AD) ) ,  DEFS 
AT  (07,39) ,PAC( HEX ( AD) ) ,  A5S 
AT  (07,53)  ,FAC( HEX( AD)  ) ,  LEGS 
AT  (07,64) ,FAC(HEX(AD) ) ,  A7$ 
AT  (09,07), 


'NORD: 


AT  (09,15),  FAC ( HEX (  34 ) ) ,  WJRD$, 

RANGE  (  ’1  "  ,  'tUUUttiU' ) , 

Al  (11,0/), 

"FIRST  SU8ST1IUTE:*, 

Ar  (11,30),  SUBON£$,CH(20), 

AT  (12,07), 

"  SECOND  SUOSTI  i"J  !'£:*, 

Ar  (12,30),  SUriIV/G$,CH(20), 

AT  (14,07), 

” PART  OF  SPEECH:”, 

AT  (14,41)  ,FAC(  HEX(  80 )  )  ,  PRIOSPCS,  CH(01), 
Ar  '(  14,57), 


CH(Oi), 


"  ( AOCIJNOPVadjn) *  , 

AT  (15,07), 

VAST  PARTICIPLE:*, 

AT  (  15,41)  ,  PPFIS 
AT  (15,57), 

"(*  or  NO  ENTRY)*, 

AT  (lb, 07), 

•NEGATIVE:*, 

AT  (16,41),  NEGF)^ 

AT  (16,57), 
or  NO  ENTRY )  *  , 

AT  (13,18),  rAC(XY2$),  ERS, 

AT  (  21,  15)  ,*Jse*,EAClHEX(  35)  )  ,  TA.-i$ ,  *  >r"  ,  FA  (  :l..Au*  >11, 
HTAi3$,*to  move  between  nod  it  i  able  tiei.is.*, 

AT  (23,30), 


Cd(Ui), 


*( 


AT  (21,  16)  ,FAC(HEX(84>  )  .ENTERS, 

AT  (23,42), 

"to  continue*, 

AT  ( 24 , 2  L ) , 

"  Press*  ,  A  T  (  24, 2 /),r'AC(  HEX(  34)  )  ,  PF  lo$,  A  Ti  .4, 

"to  exit  wiUuut  ", 

AT  (  24,43),  FAC(  HEX (  80  ) ,  NEblNGS, 

KEY.3(  AIN(  0)  o:4 IN (  16)(,HIN(  32 )  MIN(  1  )  INI  17  )  )  ,  XKY (  >pr;  )Nl  , 
O!)  (3IN(  tb)iniN(  12)  )  0)23  EXXIOD, EXAM 


>„■  i  , 


IE  (OpriDNd)  OR  ( OPT  I  >N  17)  THEN  ,)EFIN 


IF  SUOONESO"  *  THEN  CHKREST 

EKS""  The  First  Substitute  ran  not  ne  a,  ■*.' 

HEX  (94) 

O.I  TJ  EKONIMS 


/*  Cff.-jx  ter  validity  ot  entries  */ 


(REST: 


IE  PO:;(‘AHCIJi*JP7udjn*  =  PRE\)SPCS)>0  THEN  NEXT1 
•:r$  *  Purr  or  Spe-vn  value  is  illegal.” 


RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
pr 
RT 
A  L 

a: 

a: 

a: 

a? 

A  4 

A  : 
A  i 


A  . 

a  r 


a 

Al 
a  r 

i' 

ill' 
A  l’ 
A  f 
Ai' 
a  r 
a: 
a  r 


/j.Jh  a 


■  V  -V  v 
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0449 L0  XYZ$  =  HEX(94)  RT 

045010  GOTO  ERONINS  RT 

045110  RT 

045210  NEXT!:  IF  POS("  *"=-PPFL$)>0  THEN  NEXT2  RT 

045310  ER$  =  “  Past  Participle  value  is  illegal."  RT 

045410  XYZ$  =  HEX(94)  RT 

045510  GOTO  ERONINS  RT 

045610  NEXT2:  IF  FOS("  **=NEGFL$)>0  THEN  UPDATE  RT 

045710  ER$  =  "  Negative  value  is  illegal."  RT 

045810  XYZ$  =  HEX( 94)  RT 

045910  GOTO  ERONINS  '  RT 

046010  RT 

046110  EXMOD:  READ  *1,  HOLD,KEY=WORD$,  IOBUFFS  RT 

046210  IF  NF=1  THEN  NOCHAN  RT 

046310  DELETE  #1  RT 

046410  ER$=  "  The  word  1 " &WDRDS&" 1  was  not  inserted."  RT 

046510  GOTO  CWMENJ  RT 

046C10  RT 

046710  NOCHAN:  PROTECTS  =  “  "  :P%=0  RT 

046810  $PACK  (F=F1$)  IOBUFFS  FROM  WORDS, SUBONS$,SUBTTOS,  I  RT 

046910  PR  TOSPC$ ,  PPFLS ,  NBGFLS ,  PROTECTS  RT 

047U10  REWRITE  # 1 , IOBUFFS , DATA  GOTO  IOERR2  RT 

047110  ERS="  No  changes  were  saved."  RT 

047210  GOTO  CWMENU  RT 

047310  RT 

047410  UPDATE:  READ  #1,  HOLD,  KEY -WORDS ,  IOBUFFS  RT 

047510  PROTECTS  =  "  "  :P%=0  RT 

047610  SPACK  (F=F1$)  IOBUFFS  FROM  WORDS , SUBONES , SUBTWDS ,  RT 

047710  PR'TOSPCS ,  PPFLS ,  NEGFLS ,  PROTECTS  RT 

047810  REWRITE  *1, IOBUFFS, DATA  GOTO  IOERR2  RT 

047910  ER1S=  "  " 

048010  IF  NF=0  THEN  RITE  RT 

048110  IF  DF=1  THEN  EXITDEL  RT 

048210  ZAP$="  "  -  RT 

048310  ER$="  ' " &WORDS&" 1  updated  -  Please  select  next  word."  JM 

048410  E$=HEX(8C)  RT 

048510  WORD$="  "  RT 

048610  GOTO  CWMENU  RT 

048710  RITE:  RT 

048810  ERS-  "  '  "i,WORDS(«" '  inserted  -  Please  select  your  next  word."  RT 

048910  ZAP$="  "  RT 

049010  E$-  HEX  ( 80  RT 

049110  WORD$="  ’  RT 

049210  GOTO  C.VMENJ  RT 

049310  RT 

049410  EXITDEL:  DF=0  RT 

04951U  ERJ=  “  Deletion  cancelled."  RT 

049520  XS=HEX( 31 )  JM 

049530  PASSWRD$=HEX( 00U 1U203OEOF1O1 112131E1F20)  JM 

049610  GOTO  CWMENO  RT 

049710  RT 

049810  DEPIN :  RT 

049311  ACCEPT 
049812  AT  (01,01), 

04981  3  "CRF.9:  Word  Sunst itnt ion  List  Maint  Sunsystem" , 

049814  AT  (01,51),  1  JM 

049315  "(Definition  ot  Entries  Screen) * ,  I  JM 
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049816 

AT  (02,01), 

049317 

_  _  N 

l 

049818 

Ar  (05,08), 

FAC(HEX(AJ)  ), 

ITLES$ 

,  CH( 14 ) , 

U49819 

AT  (05,49), 

FAC  ( HEX  ( Ai) ) ), 

XTLE6$ 

,  CK (10), 

049820 

AT  (07,03), 

FAC( HEX( 84 ) ) , 

P$(l) 

,  CH( 03) , 

049821 

Ar  (07,08), 

049322 

"Adjective  . 

noun  or  pronoun" 

t 

049823 

AT  (08,03), 

FAC( HEX ( 84) ) , 

P$(  2) 

,  CH(03) , 

049824 

AT  (08,08), 

049825 

"Adjective/ verb  .. 

an  adjective 

049826 

or  verD", 

049827 

AT  (09,03), 

F AC  (  HEX ( 8  4 )  ) , 

P$(  3) 

,  CH( 03) , 

049828 

AT  (09,08), 

049829 

"Adverb  . 

verb,  adjective, 

or  adverb". 

049830 

AT  ( 10,03) , 

FAC( H£X( 84) ) , 

P£(  4) 

,  Cri(OJ), 

049831 

AT  (10,08), 

049832 

"Ad verb/ verb  . 

an  advero  or 

049333 

verb" , 

049834 

Al’  (11,03), 

FAC(  HKX(  84 ) ) , 

P$(  5) 

,  CH  ( 0  3 ) , 

049835 

AT '(11,08), 

049836 

"Article  . 

a  noun  (e.g. 

049837 

a,  the)". 

049838 

AT  (12,03), 

FAd(  Hb'X(  84) ) , 

P$(  6) 

,  CH ( 0  3 ) , 

049839 

AT  ( 12,08) , 

049840 

"Conjunction  . 

.g.  or)". 

049841 

AT  (13,03), 

r' AC  (  HEX  (  8  4 ) ) , 

P$(  7) 

,  CH (03), 

049842 

AT  (13,03)  , 

049843 

“ Interjection  .... 

inple  exclamations  (e.g.  Oil.’)" 

049844 

t 

049845 

AT  ( L  4 , 0  3 )  , 

FAC( HEX(  84 ) ) , 

P$(  8) 

,  CH{ 03) , 

049d4o 

AT  ( 14,08) , 

049847 

"Noun  . 

a  person,  place,  i 

or  thing". 

049848 

AT  (15,03), 

FAC(  HEX(  84  )  ) , 

P$( 13) 

,  CtilUi), 

049849 

AT  ( 15,03) , 

, 

049850 

"Noun/ adjective  .. 

a  noun  or  ad 

049851 

jective* , 

049852 

AT  (  16,01)  , 

FACi  8FX(  34 ) ) , 

F$(9) 

,  01(03), 

049853 

AT  ( 16,08) , 

049854 

"Noun/ veru  . 

nuy  function  as  a 

lluUil  OC  VO  CO 

049855 

m 

t 

049356 

AT  (  17,03), 

FAC( HEX( 84 ) ) , 

P$l 10) 

,  01(03), 

049857 

AT  (i/,08)  , 

049858 

"Preposition  . 

a  relationship  Dei 

tween  two  ole 

049859 

monts  of  " , 

049860 

AT  v  18,1)8)  , 

049861 

• 

a  sentence 

(e.g.  in,  on,  oy 

,  to,  since) 

049862 

* 

r 

049863 

AT  (  19,03), 

FAC( H£X( 84 ) ) , 

?$(  11) 

,  CH( 03) , 

049864 

AT  ( 19,08) , 

049365 

"Pronoun  . 

. Word  t )at 

nwy  o-?  used  as  a 

substitute  to 

049366 

r  a  noun" , 

049867 

AT  ( 20,08) , 

049868 

ie.g.  1,  1 

Ou  t  licit  #  ..  . 

049869 

AT  (21,01), 

FAC(  il;-',x(  84  )  ) , 

?$( 12) 

,  01(03), 

0498/0 

AT  ( 21,08) , 

049871 

"Verb  . 

action  or  occurrence". 

0498/2 

AT  !  21,20)  , 
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049873 

049874 

049875 

049876 

056210 

056310 

056410 

056510 

056610 

056710 

056310 

056910 

057U10 

057110 

057210 

057310 

057410 

057510 

057610 

057710 

057810 

057910 

058010 

058110 


'Press’ , 

AT  (23,26),  FAC( lEX( 84) ) ,  PF1$  ,  CH(03), 

AT  (23,30), 

'to  return  to  the  previous  screen', 

KEYS(aiN(l)6.aiN(17)),  ON  ( B IN ( 1 ) IN ( 1 7 )  )  GOTO  EHQNINS,ERONINS 

NEW:  PRINT  PAGE,  AT( 12,28) ,H£X(84) ;'Closing  last  tile' 

FOR  1=  1  TO  50000: NEXT  I 
FILE$=*  " 

.  CLOSE  #1 
GOTO  AGAIN 

/*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */ 

/*  SETS  UP  FLASHING  FAC’S  IN  APPROPRIATE  PLACES  */ 

DEF  FN ‘ 7 ( MSGS , 3$ , C$ , D$ ) 

PRINT 
M$=HEX( 94 ) 

G$=*8$ 

L$»C$ 

V$=0£ 

RETURN 

EXIT:  CLOSE  #1 

OUT:  /*  RETURNING  TO  SUHSTI TUTION  LIST  .MENU  */ 
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Print  Word  Substitute  List  (CRESPWSP) 

CRESPWSP  in  library  CRESPSRC  is  the  BASIC  language  program  to  print  the 
Word  Substitute  List.  The  object  language  version  is  CRcSPWSP  in  library 
CRESPSAV. 

This  program  first  allows  the  user  to  specify  the  Word  Substitute  List  to 
be  printed.  Then  the  program  enables  the  user  to  print  out  either  the  entire 
Word  Substitute  List  or  a  specified  portion.  This  printout  can  be  displayed 
at  the  terminal  or  sent  to  the  printer.  An  optional  subtitle  of  up  to  two 
lines  can  be  included  for  the  printout,  and  the  number  of  lines  per  page  may 
be  specified  as  some  value  less  than  the  default  value  of  bO. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010  /*  This  is  the  CRES  WORD  SUBSTITUTION  LIST  PRINT  PROGRAM  */  JM 
000015  /*  V  RT 
000040  /*  AUTHORS:  Rose  TanK  and  Jom  Mears  V  RT 
000025  /*  Date:  October  12,  1983  V  RT 
000030  /*  V  RT 
000035  RT 
U00U4U  /*  The  following  code  sets  up  a  screen,  wmen  asxs  for  the  */  RT 
000045  /*  name  of  the  file  containing  the  word  substitution  lisc  */  RT 
000050  /*  to  be  printed.  It  also  provides  the  opportunity  to  change  */  RT 
000055  /*  the  library  and  volume  names  which  are  set  to  the  appro-  */  RT 
000060  /*  pnate  defaults  througn  the  "extract*  system  routine.  */  RT 
000065  RT 
000070  RT 
000075  DIM  NORD$24,  BRRl$53,COQ£$i,MSG$53,F$40,G$l,CMSG$25S,MSG2$4U  RT 
000080  DIM  IOBUFF$70,ERR2$40,FIL$22  RT 
000035  DIM  FILE$08,LI8$08,RLIB$8,RVOL$6,SLIB$8,SVOL$6  JM 
00U090  DIM  IVOL$06,HEADfiR$51,L$l,V$l,B$l,C$2,D$8,M$i,MSK$2  RT 
000095  DIM  SB TI TLE$ 20 , S8TITL1$ 20  RT 
000100  DIM  EN$  05  RT 
000105  DIM  ER$  79  RT 
000110  DIM  STARTPHif  24  RT 
000115  DIM  ENDPHS  24  RT 
000120  DIM  TP$  08  RT 
000125  DIM  PP1 5$  04  RT 
000130  DIM  PP 16$  04  RT 
000135  RT 
000140  EN$=* ENTER"  RT 
000 145  PF15 S  ="PF15’  RT 
000150  PF16$="Prl6"  RT 
000155  HEADERS  ="CRES  WORD  SUBSTITUTION  LIST  PRINT  SUBSYSTEM"  RT 
000160  FII.S  ='Word  Substitution  List"  RT 
000170  r’$=  "filename  not  found  on  ( library/volume) . "  RT 
000175  P.RR  1$=  "I/O  ERROR  -  Please  specify  WORD  SUBSTIIUTION  list."  RT 
0UU18U  ERR2$=>"  I/O  ERROR  -  Internal  format  not  nutclied."  RT 
000185  CAl,L  "EXTRACT"  ADDH(  "  I V"  ,  I VOL$,  " IL" ,  LIB$,  "RL"  ,RUB$,  "R V"  ,RVOJ.$,  JM 
000140  "SL",SLIB$,"SV",SU3L$)  JM 
U0U192  f ILE$=*WRDSBLST*  JM 
000195  AGAIN:  G$=HEX(8L)  RT 
000200  MSG$»"  "  :L$=lIEX(8i)  RT 
U0U205  V$=HEX( 81 ) :  M$=HEX(3D)  RT 
000210  RT 
00 0215  FILMNU:  RT 
000220  ACCEPT  !  RT 
000225  AT  (01,01),  I  RT 
0002 30  "DIES:  Word  Substitution  List  Print  Subsystem" ,  RT 
000235  AT  (01,57),  1  RT 
000240  "(Pile  Selection  Screen)",  I  RT 
000245  AT  (02, Oi),  !  RT 
000250  “=====»=*===>““■==*=*==*==•=»”===*=“«=======»==»================:====!  RT 

000255  ===============",  I  RT 

000260  AT  (04,10),  RT 
000265  "Welcome  to  the",  I  RT 
00U270  AT  (04,26),  FAC(  HEX(  85 ) ) ,  RT 
000275  HEADERS,  I  RT 
000280  AT  (07,10),  RT 
UU0285  "Please  specify  the",  I  RT 
000290  AT  (07,29),  FAC( HEX( 84 ) ) ,  I  RT 
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000295  FILS, 

000300  AT  (07,52), 

000305  "you  want  to  print,", 

000310  AT  (08,19), 

000315  "if  the  default  values  are  not  satisfactory. ", 

000 J50  AT  (13,30), 

000355  'Pile  =", 

000360  AT  ( 13,43) ,FAC(G$) , FILES  ,  CH(08i, 

000365  RANGE  (  "I  "  ,  '££££££££££££' ) , 

000370  AT  (14,30), 

000375  "Library  =", 

000380  AT  (  14,43)  ,FAC(  [£)  ,  LIt3$  ,  01(08), 

000385  RANGE  (  '  ,  ’££££££££££££'), 

000390  AT  (15,30), 

000395  "Volume  =*, 

000400  AT  (15,43)  ,FAC(V$)  ,  IVJLS  ,  01(06), 

000405  RANGE  (  "I  *  ,  ’££££££££££££' ) , 

000410  AT  (18,20),  FAC(M$),  MSGS, 

000415  AT  (20, 30), "Press", 

000420  Ar  (20,36) ,FAC( HEX ( 84) ) , 

000425  EN$,  ' 

000430  AT( 20,42), 

000435  "to  continue", 

000440  AT  (21,17), "Press" , 

000445  AT  (21,23),  FAC( PEX( 84) ) , 

000450  PP16$, 

000455  AT  (21,28), 

000460  "Co  return  to  the  Suoscitution  List  Menu", 

000465  ON  ( l3 IN (16)  &BIN(  32)  )  GOTO  OUT 
000475 

000480  /*  SET  UP  THE  USER  FILE  BLOCK  */ 

000485 

000490  SELECT  #  1 ,  " WRDSUB "  ,  VARC ,  INDEXED,  RECSI/.B=80,KEYPOS=1,KEYLEN=20, 

000495  IOERR  GOTO  IOERR1 

000500 

000505  SELECT  #2, "PRTPILE" , PRINTER, RBCSIZE=80,  IOERR  GOTO  IOERR3 
000510 

000515  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */ 

000520 

000525  CALL  "LIMITS"  (  FILES, LIBS, IVOL$, CODES, MSGS) 

000530  IF  CODE$="Y"  THEN  LU 

000535  IF  CODES ="N"  THE.4  GOSUd’ 7(  F$,HBX(91)  ,HEX(81 )  ,HEX(  81 ) ) 

000540  IF  CODES3" V"  THEN  GOSUD' 7(STR(MSG$, 3),HEX( 81) ,HEX( 81) ,HEX( 91 ) ) 
000545  IF  COOE$-"L"  THEN  OOSUri' 7(S'IH(MSG$,3)  ,HEX(81)  ,HEX(91),HEX(81)  ) 
000550  IF  CODES'"  E"  THEN  aOSUB’ 7(STR(MSG$, 3) ,HEX(81 ) ,HEX(81 ) ,HEX( 81 )  ) 
uoo655  goto  filmn u 
000560 

000570  /*  IS  THIS  REALLY  A  WORD  SOBS  T I  TUT  ION  i.ISl?  */ 

000575 
000580  UL-. 

000585  I%=0 

000590  CALL  "KEAJFDH"  ADDR(  FILES,  LIdS,  IVUlS  ,  1* ,  "HS"  ,  HSt  ,R*  ) 

000595  IF  R.3%080  THEN  IOERR2 
000600 

000605  /*  IF  WE  FALL  HERE,  IT  MUST  BE  TIME  ID  OPEN  FILE  */ 

000610 

000615  OPEN  NOGETPA1M  #i,SilARED,  FILE-  FILES,  LIBRARY  =  LIBS, 
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0U062U 

VOLUME  =  IVOL$ 

RT 

000625 

RT 

000630 

/*  This  section  of  code  generates  the  second  screen,  which  asxs 

*/  RT 

000635 

/*  for  the  particular  word  interval  and  its  corresponding 

*/  RT 

000640 

/*  print  operation.  The  user  is  given  the  option  of  returning 

*/  RT 

000645 

/*  to  the  previous  screen  to  select  a  new  word  file  to  print. 

V  RT 

000650 

/*  or  of  returning  to  the  substitution  list  menu. 

V  JM 

000655 

RT 

000660 

RT 

000665 

ER$  =■  ■ 

RT 

000670 

CWMENU: 

RT 

000675 

WORDS  =  *  * 

RT 

000680 

SdITTLl$  ="  * 

RT 

000685 

flALONEY: 

RT 

000690 

STARTP8$  ="  FIRST" 

RT 

000695 

ENDPH$  ="LAST" 

RT 

000700 

TP$  ="TERMINAL" 

RT 

000705 

LPP%=50 

RT 

000710 

RT 

000715 

PRINTS  CR: 

RT 

000720 

ACCEPr  ' 

RT 

000725 

AT  (01,03), 

RT 

000730 

"CRES:  Word  Suostitution  List  Print  Subsystem", 

RT 

000735 

AT  (01,66), 

RT 

000740 

"(Print  Screen)", 

RT 

000745 

AT  (02,03), 

RT 

000750 

"  =  =  3  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  s  =  = 

:= 

RT 

000755 

aiaaasarsrssa1 f 

RT 

000760 

AT  (04,13), 

RT 

000765 

"To  print  a  range  of  lines,  fill  in  the  information  below.". 

RT 

000770 

AT  (06,02),  FAC( U£X( 85) ) , 

RT 

000775 

ER$, 

RT 

000780 

AT  (08,22), 

RT 

000785 

'Subtitle  of  list  =", 

RT 

000790 

AT  (08,42),  FAC( HEX( di ) ) ,S8TITLE$,CH( 20) , 

RT 

000795 

AT  (09,42),  FAC(HEX(8i)),SdTITU$,CH(20), 

RT 

000800 

AT  (11,22), 

RT 

000805 

"Starting  word  =", 

RT 

000810 

AT  (11,42) ,FAC( HEX( 81) ) ,  STARTPriH ,  CH(24), 

RT 

000815 

RANGE  (  "I  "  ,  *////////////’ ) , 

RT 

000820 

AT  (12,22), 

RT 

000825 

‘Ending  word  =", 

RT 

000830 

Af  (12,42),  FAC ( HEX ( 81 )  ) ,  ENDPrtS,  CH(24), 

RT 

000835 

RANGE  (  "I  "  , 

RT 

000840 

AT  (14,22), 

RT 

000845 

"Lines  per  page  =’, 

RT 

000850 

AT  (14,42),  FAC( HEX( 82) ) ,  LPP*,  PIC(#»), 

RT 

000855 

AT  (16,22), 

RT 

000860 

"print  at  (TERM INAL/PR INTER)  =", 

RT 

000865 

AT  (16,53),  PAC( HEX( 81 ) ) ,  TP$,  CH(08), 

RT 

000870 

AT  (20,32), 

RT 

000675 

"Press", 

RT 

000880 

AT  (20,38),  FAC( HEX( 85) ) ,  EN$,  CH(05), 

RT 

000885 

AT  (20,44), 

RT 

000890 

"to  print". 

RT 

000895 

AT  (21,17), 

RT 

000900 

"Press", 

RT 

13b 
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000905 
000910 
000915 
000920 
000925 
000930 
000935 
000940 
000945 
000950 
000955 
000960 
000965 
000970 
000975 
000980 
000985 
000990 
000995 
001000 
001005 
001010 
001015 
001020 
001025 
001030 
001035 
001040 
001045 
001050 
001055 
001060 
001065 
001070 
U0 1075 
001080 
001085 
001090 
001095 
001100 
001105 
001110 
001115 
001120 
001125 
001130 
001135 
001140 
001145 
001150 
001155 
001160 
001165 
001 1/0 
001175 
001180 
U01185 


AT  (21,23),  FAC( HEX(  84 ) ) ,  PF15$,  CH(04), 

AT  (21,28), 

“to  select  another  Word  Suostitution  List", 

AT  (22,17), 

"Press" , 

AT  (22,23),  FAC ( HEX ( 84) ) ,  PF161,  CH(04), 

AT  (22,28), 

“to  return  to  the  Suostitution  List  Menu", 

KEYS(8IN( 0 ) &BIN( 15)  &BIN( 16) &BIN( 31 ) &BIN( 32) ) , 

ON  ( BIN(  15)  6BIN(  31  )iiriIN(  16)  6>8IN(  32) )  GOTO  NEW,  NEW,  EXIT,  EX  IT 
IF  STR(TP$, 1, 1 )  =  "P"  THEN  NEXT11 
IF  STR(TP$,1,1)  <>  *T*  THEN  i'ERMPR 
NEXT11 :  IF  LPP*  < 51  THEN  NEXT13 

ER$="' Lines  per  page'  can  De  at  most  50." 

GOTO  PRINTS CP 
IOERR1 :  PRINT 

PRINT  BELL, HEX (94), ERR 1$ 

FOR  1=1  TO  200000  :  NEXT  [ 

GOTO  FILMNU 

IOERR2:  M^G$=ERR1$ 

M$=  HEX (84) 

GOTO  FILMNU 
IOEilR3:  PRINT 

PRINT  BELL,  HEX(94),  ERR2S 
FOR  1=1  TO  500000  : NEXT  I 
CLOSE  #2 
GOTO  BALONEY 

TERMPR: 

EK$="' Print  at  '  has  only  legal  values  TERMINAL  or  PRINTER." 

GOTO  PR  rNTSCR 

REX:  EkS="  'Starting  word'  comes  alter  'Ending  word'. 

GOTO  PR [NTSCR 


NEXT13 :  IF  STARTPH$=“  FIjIST"  OR  ENL)PH$=" LAST"  THEN  FORD 
IF  START PH$>KNl)PH$  THEN  REX 

/*  Now  it's  time  to  generate  our  print  file  name  */ 

FORD :  DAT$=  DATE 

DS=  STR(  DAT$,  3,2)  &“/*6STR( DAT$,  5, 2)  &"/"&STR(DAT$,  1, 2) 
T$=  STRCTIME,  1,2)4."  :“i.STR(TIME,  3,2) 

DISPLAY 

AT  (01,03), 

"CRES:  Word  Substitution  List  Print  Subsystem", 

AT  (01,61), 

"(Generation  Screen)", 

AT  (02,03), 

_ _  .  _ _ _ _ ■ 

AT  (12,23), 

"Output  file  now  being  generate! " 

PFILE$="WRDSd0tf " 

14=0 
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U01190 

001195 

001200 

001205 

001207 

001209 

001210 

001215 

001220 

001225 

001230 

001235 

001240 

001245 

001250 

001252 

001254 

001255 

001260 

001265 

001270 

001275 

001280 

001285 

001290 

001300 

001305 

001310 

001315 

001320 

001325 

001330 

001335 

001340 

001345 

001350 

001355 

001360 

001365 

001370 

001375 

001380 

001385 

001390 

001395 

001400 

001405 

001410 

001415 

001420 

001425 

001430 

001435 

001440 

001445 

001450 

001455 


NEXT14:  CONVERT  1%  TO  STR( PFILES, 7, 2) ,PIC( 00) 

r%=i%+i 

CALL  ‘LIMITS*  ( PFIL£$,SLia$,SVOL$,OC>OE$,rt3G$) 

IF  COD£$=*Y*  THEN  NEXT14 
IF  G0DE$=*E*  THEN  ER$  =  STR!MSG$,3) 

IF  ODDE$=*E*  THEN  PRINTSCR 

OPEN  NOGETPARM  #2, OUTPUT, PILE=PFIlE$, LIBRARY =SLld$, 
VOLUME=SVOL$ ,  S  PACE=  8000 
GOSU3  TTL_PGE 

IF  STARTPH$  =  ‘FIRST*  THEN  STARTPriS  =  ALL(HEX(00)) 

IF  ENDPHS  =  ‘LAST*  THEN  ENDPHS  =  ALL(HEX(FF)) 

PAGE'S  =  1 
RECS%  =  1 

READ  #1,  KEY>=*STARTPH$,IOBUFF$ 

GOSUB  HEADER 

IF  STR( IOBUFF$, 1, 18)=*  WORD  SUBSTITUTION*  THEN  READ  #1, 
I08UFFS,  BOO  GOTO  HOME 

IF  STR(IOBUFF$,,20)>STR(ENDPH$,,20)  THEN  HOME 
GOTO  KNOT 

AGAN:  READ  #1,  IOBUFF$,BOD  GOTO  HOME 

IF  'STR(IOBUFF$,,20)>STR(ENDPH$,,20)  THEN  HOME 
IF  RECS%  =  1  THEN  OOSUB  HEADER 

KNOT: 

WRITE  #2,  USING  CAT6, C£, SIR ( IOBOFFS, 1, 20) , 

STR ( IOBUFF$ , 2 1 , 20 ) ,STR ( IOBUFF$ ,41,15) 

RECS%=*RECS%U 

IF  RECS%>LPP*  THEN  RECS%=1 
IF  RECS%=1  THEN  PAGE%=PAGE%+1 
GOTO  AGAN 

HOME:  WRITE  #2,  USING  DOG,  C$ 

WRITE  #2,  USING  DOG,  C$ 

WRITE  12,  USING  CAT8,  C$ 

CLOSE#2 

IF  STR(TP$, 1 , 1 )  =*P"  THEN  MESS 
CLOSE  WS 

MSG2$  *  ‘CANCEL  Processing* 

MSK$=HEX(00) 

CMSGD  =  *  " 

CALL  "LINK*  ADDR(  "DISPFILE" ,  "P"  ,RLI84>,RVOL$,  3%,PFILE$, 
SLIB$ , SVOL$, *C* , MSG 2$, 27%, * H* , MSK$, CMSG$ , 255% , C% , R% ) 

ER$  =  "  " 

IF  04  00  OR  R4<>0 

THEN  ER$  =  STR{CMSG$, 141) 

GOTO  CWMENU 

MESS:  ER$=*  Pile  *&PFILE$&*  in  Library  *&  SLIB$  &*  on  "  6 

S\A)L$  &*  generated." 

GOTO  BALONEY 

NEW:  PRINT  PAGE,  AT( 12, 28) ,HEX( 84) ;*Closing  last  file* 

FOR  1=  1  TO  50000  :NEXT  I 
CLOSE  #1 :FILE$=  *  * 

OOTO  AGAIN 

TTL_PGE: 

C$=HEX( 8001 ) 

WRITE  12,  USING  (XDG,  C$ 


n! 
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001460 

CS  =  REX( 0015) 

001465 

WRITE  |2,  USING 

DOG,  CS 

001470 

CS  =  HEX(0001) 

001475 

WRITE  |2,  USING 

DOG1,  CS 

001480 

WRITE  |2,  USING 

DOG2,  CS 

001485 

WRITE  #2,  USING 

DOG0,  CS,D$,TS 

001490 

WRITE  |2,  USING 

DOG  3,  CS 

001495 

WRITE  #2,  USING 

DOG2,  CS 

001500 

WRITE  12,  USING 

DOGl,  CS 

001505 

WRITE  |2,  USING 

DOG2,  CS 

001510 

IF  SBTITLES  =  * 

’  THEN  GERRY 

001515 

WRITE  #2,  USING 

DOG4,  CS,  SBTITLES 

001520 

IF  S8TITL1SO* 

*  THEN  WRITE  12 

001525  DOG10, 

C$,  SBTITL1S 

001530 

WRITE  |2,  USING 

DOG2,  CS 

001535  GERRY: 

WRITE  |2,  USING 

DOG5,  CS,  FILES 

001540 

WRITE  |2,  USING 

DOG  2,  C$ 

001545 

WRITE  #2,  USING 

DOG6,  C$,  LIBS 

001550 

WRITE  #2,  USING 

DOG2,  CS 

001555 

WRITE  12,  USING 

DOG7,  CS,  ivolS 

001560 

WRITfe  12,  USING 

DOG2,  CS 

001565 

WRITE  #2,  USING 

DOG8,  CS,  STARTPilS 

001570 

WRITE  #2,  USING 

DOG2,  CS 

001575 

WRITE  |2,  USING 

DOG9,  CS,  ENDPHS 

00 I 580 

WRITE  #2,  USING 

DOG2,  CS 

001585 

WRITE  |2,  USING 

DOGl,  CS 

001590 

RETURN 

001595 

001600  READER: 

001605 

IF  PAGE*=i  THEN 

FIRST 

001610 

CS  =  REX(OOOl) 

U01615 

WRITE  |2,  USING 

ixxj,  cS 

001620  FIRST: 

CS  =  REX( 8001) 

001625 

WRITE  |2,  USING 

DOG,  C$ 

001630 

CS  =«  HEX(0001) 

, 

001635 

IF  SBTITLES  =  * 

« 

00 1640 

THEN  WRITE  |2,  USING  CAT,C$,DS,T$,PAGE% 

001645 

ELSE  GOTO  FOOT 

001650 

GOTO  ALRITE 

001655  FUUT: 

WRITE  |2,  USING 

CA  T1 ,  C$ ,  Sd  IT  TLE$ ,  D$ ,  IS ,  PAGE* 

001660 

IF  SBTITLISO' 

« 

0(11668  THEN  Will  IE  12,  USING  CAT7,C$,SBTI  TL1$ 

001670  ALRITE:  WHITE  #2,  USING  CAT 2,  CS,  FILES,  LIBS,  IVOLS 
001675  WRITE  |2,  USING  CAT3,  CS 

001680  WRITE  |2,  USING  CAT4,  C$ 

UU1685  WRITE  #2,  USING  CATS,  C$ 

001690  WHITE  12,  USING  CAT 3,  C$ 

001695  RETURN 

UUi/00 

001705  DOG0:*M  I  (MtllM 

001710  HIM  : 

001715  DOG:  %|t 
001720  DOGl:*ll 

1)01725  - : 

001/30  DOG2:*M  ! 

001735  : 


USING 


001740  DOG 3 : * II 


WORD  SUBSTITUTION  LIST 


RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
I  RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
I  RT 
!  RT 
RT 
RT 
RT 
I  RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
I  RT 
RT 
RT 
1  RT 
RT 
:  RT 
RT 
!  RT 
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001745 

*****  J 

RT 

001750 

DOG4:%|| 

1  TITLE  OF  LIST: 

hhhhhhh: 

RT 

001755 

*###«* 

RT 

001760 

DOG5:%H 

:  INPUT  FILE: 

iiiiiiii  : 

RT 

001765 

1 

RT 

001770 

DOG6:%H 

1  INPUT  LIBRARY: 

HHHH 

RT 

001775 

I 

RT 

001780 

DOG7:%|| 

1  INPUT  VOLUME : 

Him  : 

RT 

001785 

1 

RT 

001790 

DOG8:%|| 

1  STARTING  V40RD: 

iiiiHiimmi 

RT 

001795 

*#**#*  1 

RT 

001800 

DOG9:%|| 

!  ENDING  VORD: 

hhhhhhh: 

RT 

001805 

min  : 

RT 

001810 

DOG10:%I| 

1 

IIIHIIHIIIf ! 

RT 

001815 

111*111 

RT 

001320 

CAT : % I I  tlllllll 

#*### 

1 

RT 

001825 

PACE  Hill 

RT 

001830 

CAT !:%##  TITLE  OF 

LIST  :  IHHHHHHHHHI 

HHHH  ! 

RT 

001835 

Hill  PACE  Hill 

RT 

001840 

CAT7.-HI 

HHHHHHHHHH 

RT 

001845 

CAT2:%||  Input  File  is  HHHH  in  LiDrar/  Hllllll 

on  Volume  III! 

RT 

001850 

HI 

RT 

001855 

CAT3  :%H========= 

=  3=  =  ==S  =  =  =  S  =  =  ===3=S  =  =  53=  =  3=3a  =  =  S" 

323:2233133333* 

RT 

001860 

===*=■ 

RT 

001870 

*CAT4:%H  v*JR D 

First 

Second 

RT 

001875 

*  Part  o£  Past 

RT 

001885 

*CAT5:  61 1 

Suostitute 

Suostitute 

RT 

001890 

*  Speech  Part. 

RT 

001900 

*CAi’b: %H  HHHHHHIHHHI  tHHHHHIHHHH 

iimiimim 

RT 

001905 

*  1  I 

RT 

001910 

CA  T4 :  4 1 1  v*7RD 

First 

Second 

RT 

001915 

RT 

001920 

CAT5:%|# 

Suostitute 

Suostitute 

RT 

001925 

RT 

001930 

CAT6:«H  IIHIHIHHHHHH  IHHHHHHHHHI 

HIHHHHHi: 

RT 

001935 

1 

RT 

001940 

CAT8:HI  1  I !  END 

OF  LISTING  I’. 

RT 

001945 

RT 

001950 

/*  THIS  FUNCTION 

PRINTS  OUT  ERROR  MESSAGES  AND  */ 

RT 

001955 

/*  sers  UP  FLASHING  FAC’S  IN  APPROPRIATE  PLACES  */ 

RT 

001960 

DEF  FN 1 7 ( MSG$ , B$ , 

C$,D$) 

RT 

001965 

PRINT 

RT 

001970 

M$=HEX( 94 ) 

RT 

001975 

G$=B$ 

RT 

001980 

L$=C$ 

RT 

001985 

V$=D$ 

RT 

001990 

RETURN 

RT 

001995 

RT 

002000 

EXIT:  CLOSE  |i 

RT 

002005 

OUT:  /*  RETURNING  TO  SUBSTITUTION  LIST  MENU  V 

JM 
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Create/Maintain  Phrase  Substitute  List  (CRES3PSL) 


CRES0PSL  in  library  CRESOSRC  is  the  BASIC  language  program  to 
create/maintain  the  Phrase  Substitute  List.  The  object  language  version  is 
CRES@PSL  in  library  CRES@SAV. 

This  program  first  allows  the  user  to  specify  the  Phrase  Substitute  List 
to  be  created  or  maintained.  Then,  the  program  enables  the  user  to  add, 
delete,  or  modify  any  given  phrase  and  its  substitute! s) .  Up  to  two 
substitutes  can  be  specified  of  up  to  20  characters  each. 

The  only  characters  accepted  in  the  input  phrase  or  its  substitute! s)  are 
the  letters  A  through  Z,  ".,l,  and  There  can  be  no  embedded  blanks. 

A  complete  data  record  description  is  provided  in  appendix  A. 

There  is  a  protection  system  implemented  for  this  list,  and  the  program 
makes  provision  for  clearing  the  protect  bytes,  if  for  some  reason  the  bytes 
have  been  left  set  incorrectly. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010  /*  This  is  the  CRES  PHRASE  SUBSTITUTION  MAINTENANCE  SUBSYSTEM  */  RT 
000020  /*  */  RT 

000030  /*  AUTHORS:  Rose  TanK  and  John  Mears  */  RT 

000040  /*  Date:  Octooer  12,  1983  */  RT 

000050  /*  V  RT 

000060  RT 

000070  /*  Tlu  following  code  sets  up  a  screen,  which  asks  for  the  */  RT 
000080  /*  nanv;  of  the  file  containing  the  Phrase  Suck  list  that  is  */  RT 
000090  /*  to  De  modified.  It  also  provides  tne  opportunity  to  change  */  RT 
000100  /"the  lroracy  and  volume  names  which  are  set  to  the  appro-  */  RT 
000110  /*  pnatc  defaults  tlirough  the  "Extract"  system  routine.  */  RT 

000120  RT 

000130  RT 

000140  DIM  WORDS  24,  ERR1S50,  CODES  1,MSGS50,F$40,G$1,  PROTECTS  3  RT 

000150  DIM  F 1  $ 20 ,  IOBUFFS 70 , ER i$50 , XYZ$ 1 , PASSWROS1 3 , X$1  JM 

000160  DIM  PKK$4,TAB$3,BTAB$7,PILE$8,USE«S3,USERNAME$24,WRKS'rS3  RT 

000170  DIM  LIB$8,FIL$24,MESING$16  JM 

000180  DIM  IVOh$6, HEAD ERS50, L$l, VS1 ,R$l,C$i,D$l,M$l  JM 

000190  DIM  MODS  15, SUBONES 2U , SUB’IVfJS 20  JM 

000200  DIM  DEFS19  ,  JM 

000210  DIM  LEGS 5  JM 

000220  DIM  ENTERS5 , NOEX ISIS6 8 , 2 1S1  RT 

000230  DIM  EXS4  JM 

000240  DIM  ERS68  JM 

000250  DIM  L APS 2 5  JM 

000260  DF=0  JM 

000270  ENT ERS=* ENTER"  RT 

000280  TAB$="TAB"  JM 

000290  DTA3$="BACR  CAB"  JM 

000300  SELECT  II,  "PHRSUB"  ,VARC,  INDEXED, RECSIZE-70,KEYPOS=1,KEYLEN=24,  !  .JM 
000310  IOERR  GCW  IOERR1  JM 

000320  F 1$=HEX( A0 1 8A0 1 4A0 1 4A00 3000 3 )  JM 

000330  FS=>  "Filename  not  found  on  ( 1  iorary/ volume) . "  JM 

000340  ERR1S=  "I/O  ERROR  -  Please  check  filename  and  respecify. "  JM 

000350  CALL  "EXTRACT"  ADDR( ’ ID" , USERS, "1l" , LIBS, "IV" , IVOLS)  JM 

000360  FILES-"  PHRSB  LST"  JM 

U0037U  AGAIN:  G$=HEX(8i)  JM 

000380  MSG$="  * :L$=HEX( 81)  JM 

000390  V$=HEX(81):  M$=HEX(8D)  JM 

000400  HEADERS  ="CRES  PHRASE  SUBSTITUTION  MAINTENANCE  SUBSYSTEM"  JM 

000410  FILS  =*Plirase  Suostitutiou  List"  RT 

000420  EXS=" PF16"  JM 

000430  JM 

000440  FIIV4NU :  JM 

00U45U  ACCEPT  JM 

000460  AT  (01,01),  1  JM 

000470  "CRES:  Phrase  Sunstitution  List  Maintenance  Suosystem",  !  JM 

000480  AT  (01,67),  !  JM 

000490  "(File  Selection  Screen)",  !  JM 

000500  a r  (02,01),  :  rt 

000  5 1U  "  =  =  =  =  =====  =  ==  =  ==  =  =  =  =  =  =====  =  =  =  =  =  =  =  =  =  =  =  ===  =======  ==============;  RT 

000520  =  =  =  =  =  =  =  =  -.=",  1  RT 

UU05JU  AT  (04,10),  !  RT 

000540  "Welcome  to  tlie",  I  RT 

000550  AT  (04,25),  FAC( HEX( 80) ) ,  !  RT 

0UU560  HEADERS,  I  RT 

00057U  AT  (U/,04) ,  I  RT 
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000580  "Please  specify  tin",  I  RT 
000590  AT  (07,23),  FAC(  IIEX(  84) ) ,  RT 
000600  FILS,  I  RT 
000610  AT  (07,48),  !  RT 
000620  "you  want  to  modify  or  create,",  I  RT 
000630  AT  (08,04),  I  RT 
000640  "if  the  default  vaLues  are  not  satisfactory .  ",  !  RT 
000650  AT  (13,30),  !  RT 
000660  'file  1  RT 
000670  AT  ( 1 3 , 4 3 ) , FAC ( G$ ) , FILES  ,  CH(08),  !  RT 
000680  RANGE  (  **.  ’  ,  •££££££££££££’ ) ,  I  RT 
000690  AT  (14,30),  I  RT 
000700  "LiDrary  =",  l  RT 
000710  AT  (14,43)  , FAC(L$) ,  LIB$  ,  CH(06),  RT 
000720  RANGE  (  *!  "  ,  '££££££££££££'),  !  RT 
000730  AT  (15,30),  \  RT 
000740  "Volume  =",  I  RT 
000750  AT  ( 15,43) ,FAC(V$) ,  IVOL$  ,  CH(06),  I  RT 
000760  RANGE  (  "1  "  ,  '££££££££££££'),  \  RT 
000770  AT  (,18,24),  FAC(M$),  MSG$,  !  RT 
000780  AT  (20, 30), "Press',  t  RT 
000790  AT  (20,36)  ,PAC( i(EX( 84) ) ,  RT 
000800  ENTERS,  I  RT 
000810  AT( 20,42) ,  \  RT 
000820  "to  continue",  1  RT 
000830  AT  (21, 15), "Press",  !  RT 
000840  AT  (21,21),  FAC( HEX( 84) ) ,  1  RT 
000850  EX$  ,  .'  RT 
000860  AT  (21,26),  !  RT 
000870  "to  return  to  tin  Suuscitution  List  Menu",  I  RT 
000880  ON  (BIN(  16)6tJIN(  32)  )  GOTO  OUT, OUT  RT 
000930  RT 
000940  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */  RT 
000950  RT 
000960  CALL  " LIMITS" ( FILES, LIBS, IVOLS, CODES, MSGS)  RT 
000970  IF  OODE$="y"  THEN  GOTO  /././,  RT 
000980  IF  ODDE$="N"  THEN  CREATE  RT 
000990  IF  CODES =*V"  THEN  GUSJB*  7(STR(MSG$, 3)  ,HEX( 81)  ,HEX( 81 )  ,HEX( 91) )  RT 
001000  IF  CDDES="L"  THEN  GOSUB’ 7(STR(MSG$, 3)  ,HEX(  81 ) ,HEX( 91 ) , HEX( 81 ) )  RT 
001010  IF  OODES="E“  THEN  GOSUH1 7(STR(MSG$,3),HEX(81),HEX(81),HEX(81))  RT 
001020  GOTO  FI1V4NJ  RT 
001030  RT 
001040  /*  IF  WE  FALL  MERE,  IT  MUST  BE  TIME  TO  OPEN  FILE  */  RT 
001050  CREATE:  RT 
001060  DIM  PF1S  03  RT 
001070  PF 1$  - " Pf 1 "  RT 
001080  ACCEPT  RT’ 
001090  Al'(  01,01),  I  JM 
001100  "CRES:  Phrase  Substitution  r.ist  Maintenance  Suosystem",  1  JM 
001110  AT  (01,60),  I  JM 
001120  "(Create  File  Screen)’,  '.  JM 
001130  AT  (02,01),  I  RT 
001140  "  ================-=--=-- =====■===== ====3===== =========== ========» ;  rt 

001150  ===============",  :  RT 

001160  AT  (0b, 08),  I  RT 
001170  "Trn  rile  you  mv  -  selected  does  not  currently  exist  in  tne  iiora!  RT 
001180  ry",  I  kt 
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001190  AT  (07,08),  RT 
001200  ’and  volume  specified.  Por  /our  convenience,  the  following  are  *,!  JM 
001210  AT  (08,08),  i  RT 
001220  "the  parameters  you  submitted.",  I  RT 
001230  AT  (11,30),  :  RT 
001240  "File  =*,  RT 
001250  AT  (11,40) ,FAC(H£X(8b) ) ,  FILES  ,  CH(0B),  1  RT 
001260  AT  (12,30),  (  RT 
001270  "Library-" ,  1  RT 
001280  AT  (12,40),  FAC( HEX( 85) ) ,  LIBS  ,  CH(08),  !  RT 
001290  AT  (13,30),  l  RT 
001300  "Volume  =",  I  RT 
001310  AT  (13,40),  PAC(  HEX(  85) ) ,  IVOL$  ,  CH(06),  !  RT 
001320  AT  (17,15),  \  RT 
001330  "To  create  a  new  file  from  these  parameters,  press",  JM 
001340  AT  (17,65),  PAC( REX( 85) ) ,  ENTER $  ,  CH(OS),  !  RT 
001350  AT  (19,26),  !  RT 
001360  "To  select  another  file,  press",  JM 
001370  AT  (19,56),  FAC(riEX(85) ) ,  PF1$  ,  Cri(03),  I  RT 
001380  KEYS ( BIN (  0)j6BIN(  1) &BIN( 17) ) ,  KEY  (OPTION ) ,  I  RT 
001390  ON  (8IN(  1)&BIN(  17) )  GOTO  FILMNU,FILMNU  RT 
001400  RT 
001410  OPEN  NUGETPA Rrt  #1,  OUTPUT,  P lLfi=  PILE$,  LIBRARY-LIBS,  I  JM 
001420  VOLUME-  IVOL$,  SPACE=1000  JM 
001430  IOBUFFS—  "  PHRASE  SUBSTITUTION*  JM 
001440  WRITE  #1,  IOBUFFS  JM 
001450  CLOSE  #1  JM 
001460  GOTO  221  JM 
001470  ZLZ  :  CALL  "READPDR"  ADDR(  PILES, LIB$,  IVOL$, 0% ,  "RS"  ,RSI2% , RET% )  JM 
001480  IP  RSIZS<>70  THEN  ERROW  JM 
001490  221:  OPEN  NOGETPARM  #1, SHARED,  FILE-  PILES,  LIBRARY  =  LIBS,  I  JM 
001500  VOLUME  =  IVOLS  RT 
001510  READ  #1,  IOBUFFS  JM 
001520  IF  STR( IOBUFFS, 1,20)  ="  PHRASE  SUBSTITUTION"  THEN  YES  JM 
001530  CLOSE  #1  '  JM 
001540  ERROW:  M$=HEX(94)  JM 
001550  MSG$=  ERR1S  JM 
001560  GOTO  PILMNU  JM 
001570  RT 
001580  YES:  RT 
001590  /*  This  section  of  code  generates  another  screen,  which  asKs  */  JM 
001600  /*  for  the  particular  word  and  its  corresponding  operation  -  V  JM 
001610  /*  either  insert  word,  delete  word,  or  modify  word.  The  user  is  */  RT 
001620  /*  also  at  this  point  given  the  option  of  selecting  another  V  JM 
001630  /*  phrase  suo.  list  or  of  returning  to  the  SuDstitution  List  */  JM 
001631  /*  Menu.  V  JM 
001640  RT 
001650  ZAP$="Please  select  the  phrase:"  RT 
001660  WORDS-*  "  RT 
001670  W0RDEQS-"  phrase  =  "  RT 
001680  PPKS="  PP  "  RT 
001690  OPERS-"  Operation"  RT 
001700  0$="1"  RT 
001710  T$=*  2*  :THS="  3*  :Q$="  14"  :RS="  15"  :SS="  16"  RT 
001720  HRS  -"  "  RT 
001730  ER1S-*  *  RT 
001740  PASSWRD$=HEX( 000 102030E0F1011 1213 1EIP20)  JM 
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001750 

001760 

001770 

001780 

001790 

001800 

001820 

001830 

001840 

001850 

X$=HEX(  81 ) 

NOEXIST$="The  phrase  you  are  attempting  to  modify  dues  not  exist" 
&"  in  this  list." 

Z 1$=HSX( 84 ) 

CWMENt) : 

ACCEPT 

AT  (01,01), 

"CUES:  Phrase  Substitution  List  Maintenance  Suosystem", 

AT  (01,56),  “(Phrase  6  Option  Screen)", 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

.JM 

JM 

UUlooU 

ooia/o 

RT 

001880 

AT  (04,11),  FAC(HEX(  80  ) , 

RT 

001890 

ZAPS, 

RT 

001900 

AT  (06,27),  FAC ( HEX  (80), 

RT 

001910 

WOHDEOS  , 

RT 

001920 

AT  (06,36),  FAC(X$),  WORDS 

CH( 24) 

f 

JM 

001930 

AT  (08, 1U),  FAC(ZiS) ,  ERS, 

RT 

001940 

AT  (09,18),  FAC(Z1$),EK1$, 

RT 

001950 

AT  (,11,08), 

JM 

001960 

"To  continue,  select  the  PF  Key  corresponding 

to  the 

desired  oper 

JM 

001970 

at  ion. " , 

JM 

001980 

AT  (13,30),  FAC( HEX( A5) ) , 

RT 

001990 

PFXS  , 

R  i 

002000 

AT  (13,38),  FAC( HEX( AC) ) , 

RT 

002010 

OPERS, 

RT 

002020 

AT  (15,31),  FAC(HEX( 84) ) , 

RT 

002030 

0$  , 

RT 

002040 

AT  (15,39), 

RT 

002060 

"INSERT  phrase", 

JM 

002060 

AT  ( 16,31),  FAC( HEX( 84 ) ) , 

RT 

002070 

TS  , 

RT 

002080 

AT  (16,39), 

RT 

002090 

"DELETE  pnrase". 

JM 

002100 

AT  (17,31),  FAC(ilEX(84) ),' 

RT 

002110 

THS, 

RT 

002120 

AT  ( 17,39), 

RT 

002130 

"MODIFY  piir ase". 

JM 

002140 

AT  (19,31),  FAC( HEX( 84) ) , 

RT 

002150 

2$, 

RT 

002160 

AT  (  19, 39) , 

RT 

002170 

"Protection  Override", 

RT 

002180 

AT  (20,31),  FAC ( HEX ( 8 4 ) ) , 

RT 

002190 

R$  , 

RT 

002200 

AT  (20,39), 

RT 

J02210 

“Return  to  Phrase  Sup  ^ist  Selection", 

JM 

002220 

AT  (21,31),  FAC( HEX( 34) ) , 

RT 

002230 

S$  , 

RT 

002240 

AT  (21,39), 

RT 

002250 

“Return  to  Substitution  List  Menu", 

RT 

002260 

KEYS) PASSWRDS) , 

JM 

002270 

KEY(OPnON) 

JM 

002280 

IF  OPTION  =  lb  OR  OPTION-31  THEN  NEW 

JM 

002290 

IF  OPTION  - 16  OR  OPTION-32  THEN  EXIT 

JM 

002300 

RT 

002310 

FOR  1  =  1  LO  cEN(  WORDS) 

002320 

IF  ,»Jo(  "  *  AriCdEFGH I. IRiJUiJiViW  WVWX/Z-  "  S  I'K  ( WORDS ,  l , 

1  ) )  0 

14b 
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002330  THEN  ILLERR 

002340  NEXT  I 

002350 

002360  Zl$=>  HEX (  80 ) 

002370  ERl$,ER$  =*  * 

002380  IF  (OPTIGN=0) AND(DF=1 )  THEN  DEL 
002390  IF  DF=1  THEN  UPDATE 

002400  IF  (OPTION=14)  OK  (OPTION=30)  THEN  OVEKKIDE 
002410  IF  STR(WORD$, 1,1)0"  "  THEN  GOTO  REED 
002420 

002430  PRINT  HELL 

002440  ER$=“  The  first  character  cannot  be  DlanK." 

002450  ER1$=  "Please  reenter  tha  appropriate  phrase  and  PF  key." 

002460  Zl$=  HEX( 94) 

002470  GOTO  CWMENU 
002480 

002490  ILLERR: 

002500  ER$="Illegal  character  found  in  word  -  please  reenter." 

002510  Z1$=HEX( 94) :  GOTO  CWMENU 
002520  r 

002530  OVEKKIDE: 

002540  IF  NF=1  AND  P%=L  THEN  CHK 

002550  ER$=  "  First  check  if  pntase  exists  by  selecting  an  option. 
002560  Z1$=HEX( 34) 

002570  GOro  CWMENU 

002580 

002590  CHK: 

002600  IF  USER$=PROTECT$  THEN  REMOVE 

002610  ERS=  "You  don't  have  the  clearance  to  override  the  protect." 
002620  ER1$="  " 

002630  Zl$=  tlEXl  84 ) 

002640  GOTO  CWMENU 
002650 

002660  REMOVE:  PROTECT$=  "  "  :P%=0 

002670  HEAD  #1,  HOLD,  KEY=WOKD$ ,  ItWUFF$ 

002680  $PACK  (F=F1$)  I03UFF$  FROM  WORD$,  SUt30NE$,SUBTWQ$, 

002o90  PROTECTS 

002700  REWRITE  #1,  IOBUFF$,  DATA  GOTO  IOERR2 

002710  EK$-  "  You  nay  now  select  your  option." 

002720  ER1$="  " 

002730  ZL$=  ilEX(  84 ) 

002740  GOTO  CWMENU 

002750 

002760  IOERRI:  PRINT 
002770  M$=iIEX(  94 ) 

002780  MSG$-=  ERKl$ 

002790  CLOSE  »L 

002800  GOTO  FILMNU 

002810 

002820  IOERR2 :  PRINT 

002830  PRINT  HEX( 94) , "Error  occurred  on  file  ";  FILES 

002840  PRINT  HEX( 94) , "Error  code  =  *;  FS(|1) 

002850  STOP  "Touch  ENTER  to  return  to  menu." 

002860  GOTO  CWMENU 

002870 

002880  REED:  IF  OPTION 00  THEN  SKCH 

002890  EK$-  "  Command  missing." 
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002900  Zl$=  HEX(94)  rt 
002910  GOTO  CWMENU  RT 
002920  RT 
002930  SRCH:  P%=1  RT 
002940  READ  #1,  HOLD,  KEY=WOKD$,  IOBUFFS,  HOD  GOTO  NOTFOUND,  !  RT 
002950  DATA  GOTO  IOERR2  RT 
002960  RT 
002970  Nf=l  RT 
002980  RT 
002990  /*  Unpack  and  check  it  currently  being  noditied  by  another  */  RT 
003000  RT 
003010  SUNPACK  (  F=F  1$ )  IOBUFFS  TO  WGRDS,SUBON£S,SUB'TWOS,  RT 
003020  PROTECTS  RT 
003030  if  pRarecr$=  "  ■  then  non  rt 
003040  CALL  "FINDUSER*  ADDR( PROTECTS, USERNAMES, WRKSTi)  RT 
003050  CONVERT  WRKST%  TO  WRKSTS,  PIC(#§#)  RT 
003060  Z1S=  HEX( 94)  RT 
003070  ERS="  Sorry,  "&  USERNAMES  o*  is  currently  editing  "  RT 
003080  ERl$="  6  WORDS  &  *'*  &  *  at  workstation  *&  WRKSTS  RT 
003090  REWRITE  I l,  IOBUFFS  RT 
003100  GOTO  CWt4ENU  RT 
003110  RT 
003120  NOW:  PROTECT$=  USERS  RT 
003130  SPACK  (F=F1$)  IOBUFFS  FROM  WORDS, SUBONES,SUBTWOS,  1  RT 
003140  PROTECTS  RT 
003150  REWRITE  #1,  IOBUFFS,  DATA  GOTO  IOERR2  RT 
003160  RT 
003170  /*  NOW  BRANCH  TO  THE  OPTION  SELECTED  */  RT 
003180  OPT:  ON  OPTION  GOIO  INSERT, DELET,MODIFY  RT 
003190  ON  OPTION-16  GOTO  INSERT, DELET, MODIFY  RT 
003200  RT 
003210  NOTFOUND:  NF=0  RT 
003220  GOTO  OPT  RT 
003230  ,  RT 
003240  INSERT:  '  RT 
003250  /*  NF=0  indicates  th?  word  doesn't  yet  exist  so  go  aliead  V  RT 
003260  /*  and  insert.  NF=1  indicates  the  word  exists.  */  RT 
003270  RT 
003280  IF  NF  =  1  THEN  EXIST  RT 
003290  MOoS=  " ( Insert  Screen) *  RT 
003291  MESING$=" insert ing  phrase"  JM 
003300  SUiVJNE$,SJBTWOS=*  ’  RT 
003310  PROTECTS'-  USERS  RT 
003320  S PACK  (F=F1$)  DRUPES  FROM  WORDS,  SUBONES,SUB'iWO$,  !  RT 
0033  10  PROTECTS  RT 
003340  WRITE  »1,  IOBUFFS,  DATA  GOTO  IOERR2  RT 
003350  GOTO  INS  RT 
003390  RT 
003400  EXIST:  RT 
003410  ERS  =  *  To?  pnrase  &  k*)RO$  &  already  exists  in  this  list."  RT 
003420  Zl$=  HEX( 94 )  RT 
003430  READ  #1,  HOLD,  KEY=  WORDS,  IOBUFFS, DATA  OOiO  IOERR1  RT 
003440  PROTECTS- *  ":P*=0  RT 
003450  Space  (p=fi$)  iobuffs  from  words,  subone$,subi\toS,  :  rt 

003460  PROTECTS  RT 
003470  REWRITE  #1,  IOBUFFS,  DATA  GOTO  IOERR2  RT 
003480  GOTO  CWMENU  RT 
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003490 

003500 

003510 

003520 

003530 

003540 

003550 

003560 

003570 

003580 

003590 

003600 

003610 

003620 

003630 

003631 

003640 

003650 

003660 

003670 

003680 

003690 

003700 

003710 

003720 

003730 

003740 

003750 

003760 

003770 

003780 

003790 

003800 

003810 

003820 

003830 

003831 


DELET:  IF  NF=0  THEN  NODEL 
DF=1 

*  Press  ENTER  to  confirm  deletion  of  *6  VORD$ 

ER1$=*  or  PF14  to  cancel  tne  deletion.* 

Zl$=  HEX( 94) 

PASSWRD$»H£X( 000E1E ) 

X$=HF.X( 84) 

GOTO  CWMENU 

DEL:  READ  #1,  HOLD,KEY=WORD$, IOSUFF$ 

DELETE  #1 
DF=0 

ER$»  *  ' “&WORDS6" '  deleted  -  Please  select  your  next  phrase. 

ZAP$=*  * 

NF=0 

X$=*HEX(81) 

PASSWRD$=HEX( 000 102Q30E0F 1011121 31E1F20) 

Zl$=  HEX ( 8C ) 

WORCtf’"  * 

GOOD  CWMENU 

NODEL: 

ERS-  *  The  phrase  '  "&WORDS&  does  not  exist  in  this  list. 
Zl$=  HEX( 94) 

GOTO  CWMENU 


MODIFY :  IF  NF=1  THEN  GEUT 
ERS  =  NOEXISTS 
Z1$-HEX(94) 

GOTO  CWMENU 


/*  if  word  not  in  list,  */ 

/*  set  up  message  and  fac  and  */ 

/*  go  oacx  up  to  previous  screen  "/ 


GETIT:/*READ  |l,HOLD,KEY=WOHD$, IOBUFF$,BOD  GOTO  NOrFOUND,  */ 
/‘DATA  GOTO  IOERR2  V 


MOD$  =* (Modify  Screen)' 

MESING$="n*jdifying  phrase* 


003840  INS: 

003850  DEF$  ’’CURRENT  SU3STI TUTES* 

003860  LEGS  ’"LEGAL  ENTRIES" 

003870  ER1S 

003880  XYZ$  =  HEX (80 

003890  ERONINS: 

003900 

003910  ACCEPT 

003920  AT  (01,01), 

003930  "CRES:  Phrase  Substitution  List  Maintenance  Subsystem  , 

003940  AT  (01,66),  PAC( HEX( 80  )  ,fOD$, 

003950  AT  (02,01),  *===========================“===-===-== 

003970  AT  (05,07), 

003980  'Please  enter  the  appropriate  substitutes.*, 

003990  AT  ( 07,10) ,FAC(XYZ$) , ER1S, 

004000  AT  (10,33) ,FAC( H£X( AD) ) ,  DEF$  , 

004010  AT  (12,07), 

004020  'PHRASE:*, 

004030  AT  (12,15), FAC(HEX( 84) ) ,  WORDS, 


RT 
RT 
RT 
RT 
RT 
RT 
JM 
JM 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
JM 
JM 
JM 
RT 
RT 
RT 
RT 
1  RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
Rr 
RT 
JM 
RT 
JW 
RT 
RT 
RT 
R'i 
RT 
1  RT 

:  rt 

1  RJ 

:  rt 

!  R’J 

:  ri 

RT 
:  jf 
1  R' 
:  «. 
:  R1 

;  r 

’.  R 
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004040 

RANGE  (  " 1  "  ,  “////////////“ ) , 

RT 

004050 

AT  (14,07), 

RT 

004060 

"FIRST 

SUBSTITUTE: ", 

RT 

004070 

AT  (14,32),  SU30NES ,  CH  (  20 ) , 

RT 

004080 

AT  (16,07), 

RT 

004090 

"SECOND  SUBSTITUTE : " , 

RT 

004100 

AT  (16,32),  SUaTiC$,CH(20), 

RT 

004110 

AT  (20,17), "Use" , PAC( H£X( 85) )  /TABS, "or* ,PAC( HEX( 85 ) ) , 

RT’ 

004120 

3TAB$,"to  move  between  modifiable  fields.*, 

RT 

004130 

AT  (23,30), 

RT 

004140 

"Press 

# 

RT 

004150 

AT  (23, 36), PAC(HEX(84)), ENTERS, 

RT 

004160 

AT  (23,42), 

RT 

004170 

"to  continue". 

RT 

004180 

AT  (24,20), 

RT 

004190 

“Press 

, AT( 24,26) ,PAC(riEX( 84) ) , EXS, AT( 24,31), 

RT 

004200 

"to  exit  without  ", 

JM 

004201 

AT  (24,47),  FAC(HEX(  80  ) ,  MESINGS, 

M 

004210 

KEYS(BIN(0)&BIN(16)&BIN(  32) )  ,KEY(OPTION) , 

RT 

004220 

ON  ( BIN(  16)£BIN(  32) )  GOTO  EXMOD ,  EXMOD 

RT 

004230 

RT 

004240 

IP  SUdONESO"  "  THEN  UPDATE 

RT 

004250 

ER1$=" 

The  First  Substitute  can  not  be  olanK." 

RT 

004260 

XY7.$=  HEX  (94) 

RT 

004270 

OOTO  ERONINS 

RT 

004280 

RT 

004290 

EXMOD: 

IF  NP=1  THEN  NOCHAN 

RT 

004300 

READ  »JL,  HOLD , KE Y  =vXJRD$ ,  IOBUFFS 

RT 

004310 

DELETE  »1 

RT 

004320 

ER$=  "  Phrase  1 "&WORDS&"'  was  not  inserted." 

RT 

004330 

GOTO  CWMENU 

RT 

004340 

RT 

004350 

NOCHAN 

READ  |1,  HOLD,  KEY=V*0RD$,  I08UFF$ 

RT 

004360 

PROTECTS  =  "  "  :  P%=0 

RT 

004370 

SPACK  (F=F1S)  IOBUFFS  FROM  W0RD$,SU3GNE$,SUBIW0$, 

RT 

004380 

PROTECTS 

RT 

004390 

REWRITE  11, IOBUFFS, DATA  GOTO  IOERR2 

RT 

004400 

ER$=“  No  changes  were  saved." 

RT 

004410 

GOTO  CWMENU 

RT 

004420 

RT 

004430 

UPDATE 

READ  11,  HOLD,  KEYWORDS,  IOBUFFS 

RT 

004440 

PROTECTS  -  "  "  :  Pi  =0 

RT 

004450 

SPACK  ( F=F1$)  IOBUFFS  FROM  fcURDS , SUdON ES , SUd'lWOS , 

RT 

004460 

PROTECTS 

RT 

004470 

REWRITE  *1,  IOBUFFS, DATA  GOTO  IOERR2 

RT 

004480 

ER1S-  *  " 

004490 

IF  NF=0  THEN  RITE 

RT 

004500 

IF  DP=>1  THEN  EXDEL 

RT 

004510 

zapS="  " 

RT 

004520 

ERS-" 

1  "tiV*9RDSi»" '  updated  -  Please  select  next  phrase" 

JM 

004530 

7, 1$=HEX(  80) 

RT 

004540 

WORDS3"  " 

RT 

004550 

GOO)  CWMENU 

RT 

004560 

KITE: 

RT 

004570 

ER$=  " 

'"iWiRDS^"'  inserted  -  Please  select  your  next  ptiruse." 

RT 

004580 

3APS=*  " 

RT 

004530 

IS  hex(8o 

RT 

lbO 
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004600 

004610 

004620 

004630 

004640 

004641 

004646 

004650 

004660 

004670 

004680 

004690 

004700 

004710 

004720 

004730 

004740 

004750 

004760 

004770 

004780 

004790 

004800 

004810 

004820 

004830 

004840 


WORDS” "  * 

GOOD  CWMENU 

EXDEL:  DF=0 

ER$=  *  Deletion  cancelled.* 

( 81 ) 

PASSWRDS=HEX1000102030E0F10U12131E1P20) 

GOTO  CWMENU 

NEW:  PRINT  PAGE,  AT(  12, 28)  ,HEX( 84)  .-'Closing  last  file* 
FOR  I”  1  TO  50000: NEXT  I 
FILES”*  * 

CLOSE  #1 
GOTO  AGAIN 

/*  THIS  FONCriON  PRINTS  OUT  ERROR  MESSAGES  AND  */ 

/*  SETS  UP  FLASHING  FACS  IN  APPROPRIATE  PLACES  */ 

DEF  PN’7(MSG$,8$,C$,DS) 

PRINT 

M$=HEM94) 

G$=*BS 

L$=C$ 

V$=D$ 

RETURN 

EXIT:  CLOSE  |1 

OUT:  /*  RETURNING  'TO  SUBSTITUTION  LIST  MENU  */ 
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CRESOPSP  in  library  CRESOSRC  is  the  BASIC  language  program  to  print  the 
Phrase  Substitute  List.  The  object  language  version  is  CRESOPSP  in  library 
CRESOSAV . 

This  program  first  allows  the  user  to  specify  the  Phrase  Substitute  List 
to  be  printed.  Then,  the  program  enables  the  user  to  print  out  either  the 
entire  Phrase  Substitute  List,  or  some  specified  portion  thereof.  This 
printout  can  be  displayed  at  the  terminal  or  sent  to  the  printer.  An  optional 
subtitle  of  up  to  two  lines  can  be  included  for  the  printout,  and  the  number 
of  lines  per  page  may  be  specified  as  some  value  less  than  the  default  value 
of  50. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010 

000020 

000030 

000040 

000050 

000060 

000070 

000080 

000090 

000100 

000110 

000120 

000130 

000140 

000150 

000160 

000170 

000180 

000190 

000200 

000210 

000220 

000230 

000240 

000250 

000260 

000270 

000280 

000290 

000300 

000310 

000320 

000330 

000340 

000350 

000360 

000361 

000370 

000390 

000400 

000410 

000420 

000430 

000440 

000450 

000460 


/*  This  is  the  CRES  PHRASE  SUBSTITUTION  LIST  PRINT  PROGRAM 

/* 

/*  AUTHORS:  Rose  Tank  and  John  Meats 

/*  Date:  October  12,  1983 

/* 

/*  The  following  code  sets  up  a  screen,  which  asks  for  the 
/*  name  of  the  file  containing  the  phrase  substitution  list 
/*  to  be  printed.  It  also  provides  the  opportunity  to  change 
/*  the  dbrary  and  volume  names  which  are  set  to  the  appro- 
/*  pr ia-_ _*  defaults  through  the  "Extract*  system  routine. 


DIM  vORD$24,ERRl$53,ODDE$l,MSG$53,F$40,G$l,CMSG$255,MSG2$40 
DIM  IOaUFF$70,EXP$31,ERR2$40,RVOL$06,RLI3$8,SLIB$8,SVOt$6 
DIM  TAB$3 , B TAri$7 , MJRDEQS9 , P ILES08 , LI8$08 , FI Lt24 
DIM  IVOL$06,HEADER$51 , L$l,  V$i  ,B$1  ,C$2,D$8,M$1  ,MSK$2 
DIM  SBTirLE$20,SBTirLl$20 


DIM  ENi 
DIM  EXf  ' 
DIM  ER$ 

DIM  STARTPH$ 
DIM  ENDPH$ 
DIM  TP$ 

DIM  PF15S 
DIM  PP16$ 


05 

04 

79,ME3SG$21 

24 

24 

08 

04 

04 


EN$  =* ENTER" 

TABj>="  TAB* 

BTAB$=*BACX  TAB" 

EXP$=’( Explanation  of  Entries  Screen)* 

MESSG$=" Pacts  of  Speed)  Codes" 

F$=  "Filename  not  found  on  (lioracy/volume) ." 

ERRl$=  "I/O  ERROR  -  Please  specify  PHRASE  SUBSTITUTION  list." 
ERR2$="I/G  ERROR  -  Internal  format  not  Hatched." 

CALC  "EXTRACT"  ADDR( * IL" , LIB$,*RV" ,RVOL$, *RL" ,RLIB$, "SL* ,SLI3$, 
"SV*  ,SVULS,  “  IV"  ,  IVOL$) 

F I L£$= " PHRSS  LST " 

AGAIN:  G$=HEX( 81 ) 

MSG$="  * :  L£=HEX( 81) 

V$=HEX( 81 ) :  M$=HEX(8D) 

HEADERS  ="CRES  PHRASE  SUBSTITUTION  LIST  PRINT  SUBSYSTEM’ 
FIL£  ="Ptirase  Suostitutxon  uist" 

EX$="  PF16* 

FIUINU: 


k. 

I 

1 

n 

000470 

000480 

000490 

000500 

000510 

000520 

ACCEPT 

AT  (01,01), 

"CRES:  Phrase  Substitution  uist  Print  Subsystem", 
AT  (01,57), 

"(File  Selection  Screen)", 

AT  (02,01), 

'.  RT 
1  RT 

:  rt 
:  rt 
:  rt 

i  RT 

000540 

t  RT 

, 

000550 

AT  (04,10), 

:  rt 

k 

000560 

"Welcome  to  the". 

:  rt 

s 

000570 

AT  (04,26) ,  FAC( HEX(  85) )  , 

!  rt 

166 
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000580  HEADERS,  '.  Rr 

000590  AT  (07,10),  !  JEM 

000600  "Please  specify  the",  1  JEM 

000610  AT  (07,29),  FAC(HEX(84) ) ,  I  JEM 

000620  FILS,  1  JEM 

000630  AT  (07,54),  JEM 

000640  "you  want  to  print,",  !  RT 

000650  AT  £08,19),  !  JEM 

000660  "if  the  default  values  are  not  satisfactory.  ",  I  RT 

000710  AT  (13,30),  RT 

000720  "File  =*,  RT 

000730  AT  (13,43) , FAC(G$) , FILES  ,  CH(0d),  !  RT 

000740  RANGE  (  "*.  "  ,  '££££££££££££'),  *.  RT 

000750  AT  (14,30),  i  RT 

000760  “Liorary  =",  !  RT 

000770  AT  ( 14,43), FAC(LS),  LId$  ,  CH(08),  (  RT 

000780  RANGE  (  "1  "  ,  ‘ ££££££££££££’ ) ,  I  RT 

000790  AT  (15,30),  I  RT 

000800  "VoLume  *",  !  RT 

000810  AT'(15,43),FAC(V$),  IVOLS  ,  CH(06),  RT 

000820  RANGE  (  "1  *  ,  "££££££££££££’),  RT 

000830  AT  (18,20),  PAC(MS),  MSG*,  J  RT 

000832  AT  (20, 30), "Press",  1  RT 

000834  AT  ( 20, 36) ,FAC( HEX( 84) ) ,  I  RT 

000836  ENS,  I  RT 

000838  AT(  20,42),  RT 

000840  "to  continue",  t  RT 

000842  AT  (21, 18), "Press",  !  RT 

000844  AT  (21,24),  FACl HEX(  84) ) ,  I  RT 

000846  EXS,  I  RT 

000848  AT  (21,29),  I  AT 

000370  "to  return  to  the  Substitution  List  Menu",  I  RT 

000880  ON  ( BIN( 16 ) &8IN( 32) )  GOTO  OUT  AT 

000890  ,  RT 

000900  AT 

000910  /*  SET  UP  THE  USER  FILE  BLOCK  */  RT 

000920  RT 

000930  SELECT  II , "PHRASE" ,VARC, INDEXED,RECSIZE=70,KEY POS=i ,KEYLEN=24 ,  i  RT 
000940  IOERR  GOTO  IOERR1  RT 

000950  RT 

000960  SELECT  #2, " PRTFILE* , PRINTER, RECSIZE=80,  IOEAR  GOTO  10EAR3  RT 

000970  RT 

000980  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */  AT 

000990  AT 

001000  CALL  "LIMITS*  (  FILES,  LIBS,  I  V0L$,  CODES  ,MSGS)  AT 

001010  IF  OODE$=" Y"  THEN  LU  AT 

001020  IF  CODE$»"N"  THEN  GOSUB' 7( F$,HEX(  91 )  ,HEX(  81 ) ,HEX( 81 ) )  RT 

001030  IF  COOES=" V"  THEN  GOSUB' 7(SIR(MSG$,  3)  ,HEX(  81  >  ,HEX(  81 )  ,HEX(  9i )  )  RT 

001040  IF  CODE$=*L"  THEN  GOSUB' 7(STR(MSG$ ,  3)  ,  HEX( 81 ) ,HEX( 91 ) ,HEX( 31 ) )  RT 

001050  IF  CODES*" S"  THEN  GOSUB'  7(STR(MSG$, 3) ,HEX( 81 ) ,HEX( 81 ) ,HEX( 81 ) )  RT 

001060  GOTO  FILMNU  RT 

001080  RT 

001090  /*  IS  THIS  REALLY  A  PHAA3E  SUBSTITUTION  LIST?  V  RT 

001100  AT 

001110  HZ:  AT 

001120  1**0  RT 

001130  CALL  "READFOR"  ADUA( F ILE$, LIB$, IVOL$, 1% , "RS" , RS* ,Rt )  RT 
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001140 

IE  H3%<>70  THEN  I0ERR2 

Rf 

001150 

Rf 

001160 

/*  IP  WE  PALL  HERE,  IT  MOST  BE  TIME  i\3  OPEN  FILE  */ 

RT 

001170 

RT 

001180 

OPEN  NOGEl’PARM  *1, SEARED,  FILE=  PILES,  LIdRARf 

=  LIBS, 

RT 

001190 

VOLUME  =  IVOLS 

RT 

001200 

RT 

001210 

/*  This  section  of  code  generates  the  second  screen. 

wnich  asks 

V  RT 

001220 

/*  for  the  particular  word  interval  and  its  corresponding 

*/  RT 

001230  /*  print  operation.  The  user  is  given  the  option  of  returning 

*/  RT 

001240  /*  to  tne  previous  screen  to  select  a  new  word  file 

to  print. 

*/  RT 

001250  /*  or  of  returning  to  the  suostitution  list  menu. 

»/  JM 

001260 

RT 

001270  WORDEQ$=" phrase  =  “ 

RT 

001280 

Rf 

001290 

ER$  =*  " 

Rf 

001300 

CWMENU : 

RT 

001310 

WORDS  =  "  ’ 

RT 

001320 

LPP%  =50 

Rf 

001330 

PF15$  ="PP15* 

RT 

001340 

PP16S  ="PF16" 

RT 

001350 

SOriTLES  =  "  * 

RT 

001360 

SriTITLlS  ="  “ 

RT 

001370 

8ALONE7: 

RT 

U01380 

STARTPHS  =*  FIRST* 

RT 

001390 

ENDPHS  ="LAST" 

RT 

001400 

TPS  “"TERMINAL" 

RT 

001410 

PRINl'SCR: 

RT 

001420 

ACCEPT 

RT 

001430 

AT  (01,03), 

RT 

001440 

“CRES:  Phrase  Suostitution  List  Print  Suos/stem", 

RT 

001450 

AT  (01,66), 

Rf 

001460 

"(Print  Screen)", 

RT 

001470 
nn i iftn 

AT  (02,03), 

RT 

l5  P 

UU  1.  i  UU 

001490 

===========»=", 

Ki 

RT 

001500 

AT  (04,13), 

RT 

001510 

"To  print  a  range  of  lines,  fill  in  the  information 

Delow. " , 

RT 

001520 

AT  (06,02),  FAC(HEX(8r>) ) , 

RT 

001530 

ER$, 

RT 

001540 

AT  (08,22), 

RT 

001550 

"Suotitle  of  list  =", 

RT 

001560 

AT  (08,42),  FAC( HEX{ 81) ) ,SBTITLE$,CH( 20) , 

RT 

001570 

AT  (09,42),  FAC(HEX(8i)),SBTIfLlS,CH(20), 

RT 

001580 

AT  (12,22), 

RT 

001590 

"Starting  phrase  =", 

RT 

001600 

AT  (12,42), FAC( HEX( 81 ) ) ,  STARTPHS,  CH( 24 > , 

RT 

001610 

RANGE  (  ■!  "  ,  ' ) , 

RT 

001620 

AT  (13,22), 

Rr 

001630 

"Ending  phrase  =", 

RT 

001640 

AT  (13,42),  FAC( HEX( 81) ) ,  ENDPHS,  CH(24), 

RT 

001650 

RANGE  (  ":  "  ,  •*£&&&&&•), 

RT 

001660 

AT  (14,22), 

RT 

001570 

“Lines  per  page  =", 

RT 

001680 

Af  (14,42),  FAC( HEX( 82) )  ,  LPP*,  P1C(##), 

RT 

001690 

AT  (17,22), 

RT 

001700 

"Print  at  ( fERMINAL/PRINTBR)  =", 

RT 
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•r 

001710 

AT  (17,53),  FAC( HEX( 81) ) ,  TP$,  CH(08), 

RT 

W" 

> 

001720 

Af  (20,32), 

RT 

001730 

“Press" , 

RT 

> 

001740 

Ar  (20,38),  FAC(HEX( 85) ) ,  EN$,  CH(05), 

RT 

001750 

AT  (20,44), 

RT 

1 

001760 

"to  print". 

RT 

001770 

AT  (21,16), 

RT 

,*• 

001780 

"Press" , 

RT 

001790 

AT  (21,22),  FAC( H£X( 84) ) ,  PF15$,  CH(04), 

RT 

001800 

AT  (21,27), 

RT 

001810 

"to  select  another  Phrase  Substitution  List", 

RT 

001820 

AT  (22,17), 

RT 

i 

001830 

"Press", 

RT 

■ 

001840 

AT  (22,23),  FAC( HEX( 84) ) ,  PF16$,  03(04), 

RT 

> 

» 

001850 

AT  (22,28), 

RT 

001860 

"to  return  to  the  Substitution  List  Menu", 

RT 

001870 

KEYS ( BIN (  0) &8IN( 15) &BIN( 16) &3IN( 31)  &BIN(  32) ) , 

RT 

*  • 

001880 

ON  lBIN(15)&3iN(31)&BIN(16)&8IN(32))  GOTO  NSW, NEW, EXIT, EXIT 

RT 

*■’ 

001890 

IF  STR(TP$,  1 , 1)  =  "P"  THEN  NEXT11 

RT 

hm 

001900 

l  IF  STR(TP$,  1, 1)  <>  "T"  THEN  TERMPR 

RT 

1 

001910 

NEXTli:  IF  LPP%  <  51  THEN  NEXT13 

RT 

001920 

BR$="‘ Lines  per  page'  can  oe  at  most  50." 

RT 

001930 

OOTO  PRINTSCR 

RT 

001940 

IOERR1 :  POINT 

RT 

001950 

PRINT  8ELL,rtEX( 94 ) , ERR1$ 

RT 

001960 

FOR  1=1  TO  200000  .-NEXT  I 

RT 

001970 

GOTO  FILMNU 

RT 

■ 

001980 

RT 

P 

001990 

IOSRR2:  MSG$=ERR1$ 

RT 

002000 

M$=  HEX( 84) 

RT 

'  j 

002010 

GOTO  FILMNU 

RT 

002020 

I0ERR3:  PRINT 

RT 

0  . 

002030 

PRINT  BELL,  HEX( 94) ,  ERR 2$ 

RT 

002040 

FOR  1=1  TO  500000  :NSXT  I 

RT 

«r 

■ 

002050 

CLOSE  12 

RT 

002060 

GOTO  BAiDNKY 

RT 

002070 

TERMPR: 

RT 

002080 

ER$="' Print  at  '  has  only  legal  values  TERMINAL  or  PRINTER." 

RT 

, ' - 

002090 

GOTO  PRINTSCR 

RT 

002100 

RT 

002110 

REX:  ER$="  ‘Starting  phrase*  comes  after  'Ending  phrase'. 

RT 

002120 

GOTO  PRINTSCR 

RT 

■ 

002150 

RT 

UU2160 

NEXT13:  IF  STAR TPil$=  "FI RST"  OR  ENOPil£="LAST"  THEN  FORD 

.JEM 

1 

002170 

IF  STARTPH$>ENDPHi  1’tlEN  REX 

JEM 

<• 

002180 

RT 

k 

002190 

/*  Now  it's  time  to  generate  our  print  file  name  */ 

RT 

U 

002200 

RT 

L 

W 

002210 

FORD :  JAT$=  DATE 

JEM 

002220 

D$=  3  TR(  DATS ,3,2)6"/" 6STM(  DAT$,5, 2 )  &’/" 6STR(  DAT$ ,1,2) 

RT 

P 

002230 

T$=  STR( TIME, 1, 2) : "4STR( TIME, 3, 2) 

RT 

002240 

RT 

002250 

OISPIAY 

RT 

" 

002260 

AT  (01,03), 

RT 

002270 

"ORES:  Phrase  Suostitution  List  Print  Suosystem", 

RT 

>  * 

002280 

AT  (01,61) , 

RT 

002290 

"(Generation  Screen)’, 

RT 

1  68 
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002300 

AT  (02,03),  ! 

RT 

002320 

=======«,  ; 

Rf 

002330 

AT  (12,23),  i 

RT 

002340 

"Output  file  now  being  generated!" 

RT 

002350 

PFILE$="PHRSU3*#‘ 

RT 

002360 

I%=0 

RT 

002370 

NEXT 14 

:  CONVERT  1%  ID  STR( PFILE$, 7, 2) ,PIC(  00) 

RT 

002380 

i%=mi 

RT 

002390 

CALL  "LIMITS'  (PFILE$,SLiafc,SVOLt, CODES, MSG$) 

JM 

002400 

IP  OOQ£$=" Y"  THEN  NEXT14 

RT 

002402 

IP  OOD£$="E"  THEN  ER$  =  STR(MSG$,3) 

JM 

002404 

IP  COOEi>=‘£"  THEN  PRINTSCR 

JM 

002410 

OPEN  NOGETPARM  #2, OUTPUT, FILE=PFILE$,LIBRARY=SLIB$,  ! 

JM 

002420 

VOLUME=SVOL$ , S  PACE=8000 

JM 

002430 

GOSUB  TTL  PGE 

RT 

002440 

If  STARTPHt  =  "FIRST"  THEN  STARTPH$  =  ALL  (HEX  (00)) 

RT 

002450 

IP  ENDPHji  =  "LAST"  THEN  ENDPH$  =  ALL(  HEX(  FP) ) 

RT 

002460 

PAGE%  =  1 

RT 

002470 

RBCS%  =  1 

RT 

002480 

READ  01,  KEY>=STARTPHi> ,  IOBUFF$ 

JEM 

002490 

JEM 

002500 

/*  RECORD  MAY  IDENTIFY  THE  FILE,  SO  SEE  If  WE  SHOULD  READ  AGAIN  */ 

JEM 

002510 

JEM 

002520 

IP  SfR(  IOBUFP$, 1,24)0"  PHRASE  SJBSTI TUTION"  THEN  HEAD 

JEM 

002530 

READ  #1 , I03UFFS, EOD  GOTO  HOMS 

JEM 

002540 

HEAD: 

GOSUB  HEADER 

JEM 

002550 

IF  STR(  IOBUPP$,l,24)>ENDPH$  THEN  HOMS 

RT 

002560 

GOIO  KNOT 

RT 

002570 

AGAN: 

READ  #1,  IOBUFP$,EOD  GOIO  HOME 

RT 

002580 

IF  SfR(  IOBUFFS,  1 , 24)>  ENDPH$  THEN  HOME 

RT 

002590 

IF  RECS%  =  1  THEN  GOSUB  HEADER 

RT 

002600 

KNOT: 

RT 

002610 

WRITE  #2,  USING  CAT6,C$,STR(  IOBUFFS,  1,24),  ! 

RT 

002620 

STR( IOBUFFS ,25,20) ,STR( IOBUFFS, 45, 20) 

RT 

002630 

RT 

002640 

RECS%=R£CS%U 

RT 

002650 

IF  RECSOLPP*  THEN  RECS*=1 

RT 

002660 

IP  RECS%= 1  THEN  PAGEi = PAGE% + 1 

RT 

002670 

GOTO  AGAN 

RT 

002680 

HOME: 

WRITE  #2,  USING  DOG,  CS 

RT 

002690 

WRITE  #2,  USING  DOG,  C$ 

RT 

002700 

WRITE  *2,  USING  CAT8,  C$ 

RT 

002710 

CLOSE#2 

RT 

002720 

IF  STR( TP$, 1,1)  ="P"  THEN  MESS 

RT 

002730 

CLOSE  WS 

RT 

002740 

MSG2$  =  "CANCEL  Processing" 

ST 

002750 

MSK$=HEX(  00) 

RT 

002760 

CMSG$  =  "  " 

RT 

002770 

CALL  "LINK"  ADDR(  "DISPFILE* ,"P" ,RLIB$,RVOL$, 3%, PFILE$, 

JM 

002780 

SLIB$,SVUL$, "C" ,MSG2$, 2  /%, "H" ,MSK$,CMSG$, 255%,C*,R%) 

JM 

002790 

ER$  =  ’  * 

RT 

00280U 

IF  C%OU  OR  R%<>U  ! 

RT 

002810 

THEN  ER$  =  STR( CMSG$, 141) 

RT 

002820 

GOIO  GWMENU 

RT 

002d30 

RT 

002840 

MESS : 

ER$="  File  " 8PF I LE$i<"  in  Liocary  "t<  SLIB$  &"  on  "& 

JM 
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002800  SVOL$  6.*  generated." 

002860  GOTO  BALONEY 

002870 

002880  NEW:  PRINT  PAGE,  Aft  12,28)  ,HEX(  84)  .-"Closing  last  Eile* 


002890 

FOR  1=  1  TO  50000  :NEXT  I 

002900 

FILE$="  " 

002910 

CLOSE  #1 

002920 

GOTO  AGAIN 

002930 

002940 

TTL  PGE: 

002950 

C$=HEX( 8001 ) 

002960 

WRITE  #2,  USING  DOG,  C$ 

002970 

CS  =  HEXt 0015) 

002980 

WRITE  #2,  USING  DOG,  CS 

002990 

CS  =  HEX (0001) 

003000 

WRITE  12,  USING  DOGl,  C$ 

003010 

WRITE  12,  USING  DOG2,  C$ 

003020 

WRITE  #2,  USING  DOGO,  C$,D$,T$ 

003030 

WRITS  12,  USING  DOG3,  CS 

003040 

WR?TE  #2,  USING  DOG2,  C$ 

003050 

WRITE  #2,  USING  DOGl,  CS 

003060 

WRITE  12,  USING  DOG2,  C$ 

0030  70 

IF  SB  TITLES  -  "  '  THEN  GERRY 

003080 

WRITE  #2,  USING  DOG4,  C$,  SBTITLES 

003090 

IF  SSfl TL1$0"  "  THEN 

WRITE  #2 

003100 

DOGIO,  CS,  S3TITL1S 

0U3110 

WRITE  #2,  USING  DOG2,  CS 

003120 

GERRY :  WRITE  *2,  USING  0OG5,  CS,  FILES 

00  3 1 30 

WRITE  #2,  USING  DOG2,  C$ 

003140 

WRITE  #2,  USING  DOG6,  C$,  LIBS 

003150 

WRITE  12,  USING  DOG2,  C$ 

003160 

WRITS  #2,  USING  DOG7,  C$,  IVOLS 

003170 

WRITE  02,  USING  OOG2,  C$ 

003180 

WRITE  #2,  USING  DOG8,  C$,  STARTPH $ 

003190 

WRITE  12,  USING  DOG2,  C$ 

003200 

WRITE  *2,  USING  DOG9,  C$,  ENDPHS 

003210 

WRITE  #2,  USING  DOG2,  C$ 

003220 

WRITE  *2,  USING  DOGl,  CS 

003230 

RETURN 

00  1240 

003260 

HEADER: 

003260 

IF  PAGE%=i  THEN  FIRST 

003270 

CS  =  HEX(OOOl) 

003280 

WRITE  1 2,  USING  DOG,  C$ 

0U3290 

FIRST:  CS  =*  HEX(8U0i) 

003300 

WRITE  »2,  USING  DOG,  CS 

003310 

C$  =  HEX(OOUl) 

003320 

IF  SB TITLES  =  " 

003330 

THEN  WRITE  #2,  USING  CAT, C$,D$,T$, PAGE* 

003340 

ELSE  GOTO  FOUT 

OU3350 

GOTO  ALRITE 

003360 

FOUT:  WRITE  12,  USING  CAT1,CS, SBTITLES, D$,T$, PAGE* 

003370 

IF  SJTITLISO' 

003380 

THEN  WRITE  #2,  USING  CAT7,C$,S3TITLiS 

003390 

ALRITE:  WRITE  #2,  USING  CAT2,  CS,  FILES,  LIBS, 

IVOLS 

003400 

WRITE  12,  USING  CAT3,  C$ 

003410 

■IRITE  12,  USING  CAT4,  CS 

Pac 
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003420  rt 

003430  WRITE  #2,  USING  CAT 3,  C$  RT 

003440  RETURN  RT 

003450  RT 

003460  DOGO :  ill  !  HllIlH  !  RT 

003470  IHH  :  RT 

003480  OOG:  %ll  RT 

003490  DOGi:%H  .’ - :  RT 

003500  - :  RT 

003510  DOG2:%|#  !  1  RT 

003520  !  RT 

003530  DOG3:%*»  .'  ******  pt«ASE  SUBSTITUTION  CIST  !  RT 

003540  *****  !  RT 

003550  DOG4:%H  I  TITLE  OF  LIST:  HHHHHHHHHi:  RT 

003560  I  !  RT 

003570  DOG5:%ll  !  INPUT  FILE:  HHHH  !  RT 

003580  !  RT 

003590  DOG6:%H  !  INPUT  LIBRARY:  *#»»##>#  1  RT 

003600  I  RT 

003610  0OG7:%||  '  I  INPUT  VOLUME:  (HIM  !  RT 

003620  !  RT 

003630  DOGS:  %H  !  STARTING  PHRASE:  11111111111111*1111!  RT 

003640  || HI  !  RT 

003650  DOG9:%H  !  ENDING  PHRASE:  ##*##«*##*##»###*#*!  RT 

003660  Hill  :  RT 

003670  DOGlO:%H  !  HHHHHHHHH!  RT 

003680  ||  I  RT 

003690  CAT:HI  llllllll  Hill  !  RT 

003700  PAGE  Hill  RT 

0U3710  CAT! : %ll  TITLE  OF  LIST  :  IIIIHIIIHIIIIIIIII  llllllll  !  RT 

003720  Hill  PAGE  IHH  RT 

003730  CAT7 : %l|  IHIIHHIIHIIHHI  RT 

003740  CAT2:%||  Input  File  is  llllllll  in  Liorary  llllllll  on  Volume  III!  RT 
003750  HI  ,  RT 

003760  CAT3 : %ll=====— ========>===================3=-====================;  RT 

003770  ====.============^==  RT 

003780  CAT4 :%H  PHRASE  First  SuDStitute  Sec!  RT 

00379U  ond  Substitute  RT 

0U3800  RT 

003810  CAT6:%H  HHHHHHHHHHHH  HHHHHHHHHH  »H1  RT 

003820  IIHHHHHHIHI  RT 

003830  CAT8:HI  ! !  END  OF  LISTING  ! !  RT 

003840  RT 

003850  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */  RT 

003860  /*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  */  RT 

0U387U  DEF  FN1  7(MSG$,Bi,Ci,D$)  RT 

003880  PRINT  RT 

003890  M$=HEX( 94 )  RT 

003900  G$=B$  RT 

003910  L$=C$  RT 

003920  V$=D$  RT 

003930  RETURN  RT 

003940  RT 

003950  EXIT:  CLOSE.  #1  RT 

00396U  OUT:  /*  RETURNING  IU  SUBSTITUTION  LIST  MENU  */  JM 
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CRES0S8P  in  library  CRESOSRC  is  the  BASIC  language  program  to  print  the 
merged  Word  Substitute  List  and  Phrase  Substitute  List.  The  object  language 
version  is  CRESOSBP  in  library  CRESldSAV. 

This  program  first  allows  the  user  to  specify  the  Word  and  Phrase 
Substitute  Lists  to  be  printed.  Then  the  program  enables  the  user  to  print 
out  either  the  entire  merged  Substitute  List  or  a  specified  portion.  This 
printout  can  be  displayed  at  the  terminal  or  sent  to  the  printer.  An  optiona 
subtitle  of  up  to  two  lines  can  be  included  for  the  printout,  and  the  number 
of  lines  per  page  may  be  specified  as  some  value  less  than  the  default  value 
of  50. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010  /*  This  is  the  CRES  WORD  t.  PHRASE  SOOSTI TUTION  PRINT  PROGRAM  */  AT 
000020  /*  V  RT 
000030  /*  AUTHORS:  Rose  Tank  and  Join  Mears  */  RT 
000040  /*  Date:  October  12,  1983  V  RT 
000050  /*  V  RT 
000060  RT 
000070  /*  The  following  code  sets  up  a  screen,  which  asks  for  the  */  RT 
000080  /*  names  of  the  files  containing  the  word  and  phrase  sub-  */  JM 
000081  /*  stitution  lists  to  be  printed.  The  screen  also  provides  */  JM 
000090  /*  the  opportunity  to  change  the  library  and  volume  names  V  JM 
000100  /*  which  are  set  to  the  appropriate  defaults  through  the  */  JM 
000110  /*  ‘Extract”  system  routine.  */  JM 
000120  RT 
000130  RT 
000140  DIM  W3RD$24,ERAl#53,COOE#l,MSG$54,Ff40,CMSG$255,MSG2$40  JM 
000150  DIM  IOBUFFP$70, IOBUFFW#80,EAR2#54,QPEN%(  2)  ,FIL$34  JM 
000160  DIM  HEADBR$40,L1$1,V1#1,G1#1,L2$1,V2$1,G2#1,B$1,C$2,D#8,M$1,MSK#2  RT 
000170  DIM  3BTITLE$20,SaTITLl#20,SLIB#8,SW3L$6,RLIB$8,AVOL$6  JM 
000180  DIM  ER$  79  RT 
000190  DIM  STARTPH#  24  RT 
000200  DIM  ENDPH#  24  RT 
000210  DIM  TP$  08  RT 
000220  DIM  PF 15$  04  RT 
000230  DIM  PFI6#  04  RT 
000240  RT 
000250  F$=  "Filename  not  found  on  ( library/ volume) . ’  RT 
000260  ERR1S=  ‘I/O  ERROR  -  Please  specify  a  WORD  SUBSTITUTION  list."  RT 
000270  EAR2$=  ‘I/O  ERROR  -  Please  specify  a  PHRASE  SUBSTITUTION  list.*  RT 
000280  ERA3$=*"I/0  ERROR  -  Internal  format  not  matched."  RT 
000290  AGAIN:  Gl#,  G2$=HEX(81)  RT 
000300  MSG$="  * :L1$,  L2$=HEX(81)  RT 
000310  V1$,V2#=HEX( 81 ) :  M#=HEX{8 D)  RT 
000320  RT 
000330  DIM  TYPE1#  22  RT 
000340  DIM  TYPE2#  24  RT 
000350  DIM  WFILE#  08  RT 
000360  DIM  PFILE#  08  RT 
000370  DIM  WLId$  08  RT 
000380  DIM  PLIB#  08  RT 
000390  DIM  WVOL$  06  RT 
000400  DIM  PVOL#  06  RT 
000410  DIM  ENTER#  05  RT 
000420  HEADER#  ="CRES  SUBSTITUTION  LISTS  PRINT  SUBSYSTEM"  AT 
000430  FIL#  ="Word  and  Phrase  Substitution  Lists"  RT 
000440  TYPEl#  ="WORD  SUBSTITUTION  LIST"  RT 
000450  TYPE 2$  ="PHRASE  SUBSTITUTION  LIST "  RT 
000460  PFILE#  =  " PHAS8LST"  RT 
000461  WFILE#  =  "WRDSBLST" 

000470  CALL  "EXTRACT"  ADDR(  “IL" ,WLIB$, “IL"  , PLIB# ,  "IV"  ,WVOL$, "  IV"  ,  PVOL#,  JM 
000480  "SL",SLIB#,"SV",SVOL$,"RL",RLI8$,"RV",AVOL$)  JM 
000490  ENTER#  =" ENTER"  RT 
000500  PF16#  =‘PF16‘  RT 
000510  FILMNU:  RT 
000520  ACCEPT  I  AT 
000530  AT  (01,03),  RT 
000540  "CRES:  Merge  Substitution  Lists  Print  Subsystem  (File  Selel  RT 
000550  ction  Screen)",  I  RT 
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000560  AT  (02,03), 

RT 

000580 

/ 

RT 

000590 

Ar  (04,id, 

RT 

000600 

"Welcome  to  the", 

RT 

000610 

AT  (04,27),  FAC( HEX( 85) ) , HEADERS  , 

CH( 39) , 

RT 

000620 

AT  (07,12), 

RT 

000630 

"Please  specify  the". 

RT 

000640 

AT  (07,31),  FAC( HEX( 84) ) ,FIL$ 

CH( 34) , 

RT 

000650 

AT  (08,26), 

RT 

000660 

"you  want  to  jointly  print.  ", 

RT 

000670 

AT  (12,07),  FAC(HEX(  85) ) ,  TiPEl$ 

,  CH( 22) , 

RT 

000680 

AT  (12,52),  FAC( HEX(85) ) ,  TypE2$ 

,  CH( 24) , 

RT 

000690 

AT  (14,09), 

RT 

000700 

"File  =", 

RT 

000710 

AT  (14,19),  FAC(G1$) ,  WFXLEi 

,  CH( 08) , 

RT 

000720 

RANGE  (  "I  "  ,  •tUt-UtHttt') , 

RT 

000730 

AT  (14,55), 

RT 

000740 

"File  =“, 

RT 

000750 

AT  14,66),  FAC(G2$) ,  PFILB$ 

,  Cri( 08 ) , 

RT 

000760 

RANGE  (  "I  "  ,  ' UtUttttttf ) , 

RT 

000770 

AT  (15,09), 

RT 

000780 

"Library  =*, 

RT 

000790 

AT  (15,19),  FAC(LIS),  WLIB$ 

,  CH( 08) , 

RT 

000800 

AT  (15,55), 

RT 

000810 

"Library  =*, 

RT 

000820 

AT  (15,66),  FAC ( L2$ ) ,  PLIB$ 

,  CHIOS), 

RT 

000830 

AT  (16,09), 

RT 

000840 

"Volume  =", 

,  • 

RT 

000850 

AT  (16,19),  PAC(  Vi$) ,  WVOL$ 

,  CH(06), 

RT 

000860 

AT  (16,55), 

RT 

000870 

"Volume  =", 

RT 

000880 

AT  (16,66),  FAC(V2$),  PVDL$ 

,  CHI  06), 

RT 

UU0890 

AT  (18,20),  FAC(MS),  MSG£, 

RT 

000900 

AT  (21,30), 

RT 

000910 

"Press’, 

RT 

000920 

AT  (21,36),  FAC(  HEX( 85) ) ,  ENTERS 

,  CH( 05) , 

RT 

000930 

AT  (21,42), 

RT 

000940 

"to  continue". 

RT 

000950 

AT  (22,18), 

RT 

000960 

"Press" , 

RT 

000970 

AT  (22,24),  FAC( HEX( 84) ) ,  PF16S 

,  CH( 04) , 

RT 

000980 

AT  (22,29), 

RT 

000990 

"to  return  to  the  Substitution  Menu", 

RT 

001000 

K£VS( BIN( 0)&BIN( 16)&BIN( 32) ) , 

001010 

ON  ( BIN( 16) &BIN( 32) )  GOTO  OUT 

RT 

001020 

RT 

001030 

Gl$,  G2$=HEX( 81 ) 

JM 

001040 

Ll$,  L2$=HEX( 81 ) 

JM 

001050 

VIS,  V2$=rlEX(  81 ) 

JM 

001060 

RT 

001070 

/*  SET  UP  THE  USER  FILE  BLOCK  */ 

RT 

OOlOdO 

RT 

001090 

SELECT  If  1 ,  "NRDSUB* ,  VARC,  INDEXED, RECS I 2E=8U , KEyt\JS=l , KEiLEN=20, 

RT 

001 100 

IOERR  GOTO  TOERRl 

RT 

00 1110 

RT 

00 1 1 20 

SELECT  il,  "PHRASE",  VARC,  INDEXED,  HECSI2E=70,  Kt’f  lOS=  1  ,KE!7LfiN=  24, 

RT 
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001130  IOERR  GOBI  I0EKR1  RT 
001140  RT 
001150  SELECT  #3, "PRTFILE", PRINTER, RECSIZE=80, IOERR  GOTO  IOERR 3  RT 
001160  RT 
001170  /*  SEE  If  THE  SPECIFIED  FILES  EXISTS  */  JM 
001180  '  RT 
001190  CALL  “LIMITS"  (WFILE$,WLIB$,WVOLt,COQ£$,MSG$)  RT 
001200  if  CODE$=’y“  THEN  CKFILE2  RT 
001210  IF  CODE$="N"  MEN  GGSU8' 7( F$,HEX(  91)  ,HEX(  81)  ,HEX(  81)  )  RT 
001220  IF  CODE$="V"  THEN  G0SU3' 7(STR(MSG$, 3) ,HEX[  81) ,HEXI 81) ,HEX(  91) )  RT 
001230  IF  COOE£="L"  THEN  GOSUB' 7<STR( MSG£,  3)  ,HEX(81)  ,HEX(  91)  ,H£X(  81) )  RT 
001240  IF  CODE$="E"  THEN  GOSUB* 7(STR(MSG$ , 3) ,H£X(  81) ,HEX( 81) ,HEX( 81) )  RT 
001250  GOTO  PILMNU  RT 
001260  CKFILE2:  RT 
001270  CALL  “  LIMITS*  ( PE ILEii,  PLI8$,PV0Li>,C0DE$,MSGi>)  RT 
001280  IF  OODE$=*y“  THEN  ZZZ  RT 
001290  IF  OODE£="N“  THEN  GOSUB' 8( F£,H£X( 91) ,HEX( 81) ,HEX( 81)  )  RT 
001300  IF  CODE$="V*  THEN  00SU8' 8(3TR{MSG$, 3) ,HEX(  81) ,H£X( 81 > ,HBX(91) )  RT 
001310  IF  CODE$="L"  THEN  GOSUB' 8(STR(MSG$, 3) ,HEX( 81 ) ,HEX( 91 ) , HBX (81) )  RT 
001320  IF  CODES =“fc“  THEN  GOSUB*  8(STR(MSGS, 3)  ,H£X(  61)  ,HEX(  81)  ,HEXl  81) )  RT 
001330  GOTO  FILMNd  RT 
001340  RT 
001350  /*  ARE  THESE  REALLy  WORD  i.  PHRASE  SUBSTi TUTION  LISTS?  */  JM 
001360  RT 
001370  ZZZ:  RT 
001360  I%=0  RT 
001390  CALL  “READFDR"  ADDRl WFILE$,WlIB$,WVOL$,  H,*R3"  ,R3%,R%)  RT 
001400  IF  RS%<280  THEN  10ERR1  RT 
001410  RT 
001420  CALL  "READFDR"  ADDR(  PFIlES, PLIBS,  PVDLS,  1%,  "RS*  ,R3%,R%  )  RT 
001430  IF  KSSO70  THEN  IOERR2  RT 
001440  RT 
001450  /*  IF  WE  FALL  HERE,  IT  MUST  BE  TIMS  TO  OPEN  FILES  »/  IM 
001460  ,  Ri 
001470  IF  OPEN% ( 1 ) =1  THEN  CLOSE  #1  RT 
001480  OPEN  NOGETPARM  11, SHARED,  F ILE=  WFILES,  LIBRARY  =  W^IB$,  RT 
001490  VOLUME  »  WVOL$  RT 
001500  OPEN%( 1 ) =1  RT 
001510  RT 
001520  IF  OPEM%(  2)  =  1  THEN  CLOSE  |2  RT 
001530  OPEN  NOGETPARM  #2, SHARED,  FIL£=  PFILES,  LIBRARY  =  PLI3$,  1  RT 
001540  VOLUME  =  PVOLS  RT 
001550  OPEN%( 2)=1  RT 
001560  RT 
001570  /*  Tins  section  of  code  generates  the  second  screen,  wtucti  asks  */  RT 
001580  /*  for  the  particular  word  interval  and  its  corresponding  */  RT 
001590  /*  print  operation.  The  user  is  given  the  option  of  returning  */  RT 
001600  /*  to  the  previous  screen  to  select  new  substitution  files  to  V  JM 
001610  /*  print,  or  of  returning  to  the  substitution  list  menu.  */  JM 
001620  RT 
001630  RT 
001640  HRjfc  ="  "  RT 
001650  CWMF.MU:  Hi- 
001660  WOilDf  =  "  "  RT 
001670  LPPt  =50  RT 
001680  PF 1 5$  =’PF15"  rt 
001690  SBTITLES  ="  "  RT 
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001700  sarrrus  ="  " 

001710  BALONEY: 

001720  WF,PF,W=0 

001730  STARTPHS  “"FIRST" 

001740  ENDPHS  “"LAST" 

001750  TPS  “"TERMINAL" 

001760  PRINTS®: 

001770  ACCEPT 

001780  AT  [01,03), 

001790  "CRES:  Merge  Suustitucion  Lists  Print  SuDS/stem", 

001800  AT  (01,66), 

001810  "(Print  Screen)", 

001820  AT  (02,03), 

001340  =============", 

001850  AT  (04,13), 

001860  "To  print  a  range  of  lines,  fill  in  the  information  oelow.", 
001870  AT  (06,02),  FAC(HEX( 85) ) , 

001880  EH$, 

001890  AT  r( 08, 20), 

001900  "Subtitle  of  list  =", 

001910  AT  (08,46),  FAC(HEX(81) ) ,SBT1TLB$,CH( 20) , 

001920  AT  (09,46),  FAC( HEX( 81) ) ,SBTITL1S,CH(  20) , 

001930  AT  (12,20), 

001940  "Starting  word  or  phrase  =", 

001950  AT  ( 12,46  ),FAC(HEX(  81)),  STARTPHS,  CH(24), 

001960  RANGE  (  "1  "  ,  n tUUUUiU* ) , 

00L970  AT  (13,20), 

001980  "Ending  word  or  plirase  =", 

001990  AT  (13,46),  FAC(  HEX(  81) ) ,  ENDPHS,  Cri(24), 

002000  RANGE  ( 

002010  AT  (14,20), 

002020  "Lines  per  page  =", 

002030  AT  (14,46),  FAC( HEX( 82) ) ,  LPP%,  PIC(#|), 

002040  AT  (16,20), 

002050  "Print  at  (  TERMINAL,/ PRINTER )  =", 

002060  AT  (16,51),  FAC(  HEX(  81)  )  ,  "PS,  CH(08), 

002070  AT  (21,32), 

002080  "Press", 

002090  AT  (21,38),  PAC(  tlEX(  85) ) ,  ENTERS,  CH(05), 

002100  AT  (21,44), 

002110  "to  print", 

002120  AT  (22,17), 

002130  "Press", 

00214U  AT  (22,23),  FAC( HEX( 84) ) ,  PF15S,  CH(Q4), 

002150  AT  (22,28), 

002160  "to  select  two  more  Substitution  Lists", 

002170  AT  (23,16), 

002180  "Press', 

002190  AT  (23,22),  FAC( HEX( 84) ) ,  PF16S,  CH(04), 

002200  AT  (23,27), 

002210  "to  return  to  the  Substitution  List  Menu", 

002220  KEYS ( 3 IN (  0 )  &QIN(  15 )  &i3IN(  16)  &l3IN(  31 )  &3IN(  32) ) , 

002230  ON  ( 8IN(  15) SBIN(  31 ) &dIN( 16) &8IN( 32) )  GOTO  NEW, NEW, EXIT, EXIT 
002240  ER$="  ’ 

002250  IF  STR( TPS, 1,1)  =  "P"  THEN  NEXTil 

002260  IF  STR(TP$,  1 , 1 )  <)  "T*  THEN  TERMPR 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

JM 

JM 

JM 

RT 


JM 

RT 

JM 

RT 

JM 

RT 

JM 

JM 

RT 

JM 

JM 

RT 

JM 

JM 

RT 

JM 

RT 

JM 

JM 

RT 

JM 

RT 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 
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002270  NEXX1  1 :  IP  LPP*<51  THEN  NEXT  1 3  RT 
002280  ER$="  Lines  per  page*  can  oe  at  most  50.*  RT 
002290  GOTO  PRINTSCR  RT 
002300  RT 
002310  lOERRi:  MSG$=ERRl$  RT 
002320  M$=  HKX( d4 1  RT 
002330  GOTO  PILMNU  RT 
002370  RT 
002380  IOERR2:  MSG$=ERR2$  RT 
002390  M$=  HEX( 84)  RT 
002400  GOTO  FILMNU  RT 
002410  RT 
002420  IOERR3:  PRINT  RT 
002430  PRINT  BELL,  HEX(94),  ERR 3$  RT 
002440  FOR  1=1  TO  50UU00  : NEXT  I  RT 
002450  CLOSE  |3  RT 
002460  GOTO  BALONEY  RT 
002470  TERMPR:  RT 
002480  E8$="  Print  at  *  las  only  legal  values  TERMINAL  or  PRINTER."  RT 
002490  GOTO  PRINTSCR  RT 
002500  RT 
002510  REX:  ER$="  ‘Starting  word'  comes  after  'Ending  word’.’  RT 
002520  GOTO  PRINTSCR  RT 
002540  RT 
002550  NEXT! 3:  IF  STARTPH$=" FIRST"  OR  ENDPH$="[A5T"  THEN  FORD  JM 
002560  IF  STARTPH$>ENDPH$  THEN  REX  JM 
002570  RT 
002580  /*  Now  it's  time  to  generate  our  print  tile  name  V  RT 
002590  RT 
002600  FORD:  DAT$=  DATE  JM 
002610  D$=  S Hi!  DATS,  3 , 2 )  &"/* &S TR( DATS, 5, 2)  &"/* &STR(  DATS,  1,2)  RT 
002620  T$=  STR( TIME, 1,2)6": '6STR( TIME, 3,2)  RT 
002630  RT 
002640  DISPfAY  ,  !  RT 
002650  AT  (01,03),  !  RT 
002660  "CRES:  Merge  Subst itut ion  List  Print  Suosysteir." ,  1  RT 
002670  AT  (01,61),  1  RT 
002680  "(Generation  Screen)*,  1  RT 
002690  AT  (02,03),  !  RT 
002700  "====  =  ===  =  ^===  =  =  ^=  =;===  =  =  =  =  ^=  =  =  =  =  ^==========================1  RT 

002710  =======.»=*»«=.",  ;  RT 

002720  AT  (12,23),  '.  RT 
002/30  "Output  file  now  toeing  generated!"  RT 
002740  PFIL$="MERSUB»»"  RT 
002750  1%=()  JM 
0U2760  NEXT14:  CONVERT  I*  TO  STR( PF1L$, 7,2) ,P1C( 00)  RT 
002770  Ii=t%*l  RT 
002780  CALL  "LIMI  TS"  ( PFIL$ ,SLIB$,SVOL$, CODES, MSG$)  JM 
002790  IF  CODE$="Y"  THEN  NEXTI4  RT 
002800  IF  OODE$="E"  THEN  ER$  =  SrR(MSG$,3) 

002810  IF  COOE$="E"  THEN  PRINi'SCK 

002820  OPEN  NOGSTPAKM  »3, OUTPUT, PILE=PFI[.$ ,  LIBRARY=SLIB$,  !  JM 
002830  \AJLUME=SVUU,SPACE=8000  JM 
002840  GOSUB  TTL  PGE  RT 
002850  IF  STARTPU$  =  “FIRST"  THEN  STARTPiLS  =  *  ILL'  RT 
002860  IF  ENDPHli  =  "LAST"  THEN  ENDPH$  =  ALL(HEX(FF))  RT 
002870  PAGE*  =  1  RT 
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V  002880 

RECS%  =  1 

RT 

S'  002890 

READ  #1,  KEy>=STARTPH$,I08JFFN$ 

RT 

002900 

READ  #2,  KEi>=STARTPHf , IOBUPFPS 

RT 

002910 

IF  STR( I08UFFWS, , 20)<STR{  I08UFPP$, , 20)  THEN  N=1  ELSE 

W=0 

RT 

b  002920 

GOSUB  HEADER 

RT 

P  002930 

IF  (STR( IOBUFFW$,,20)>STR(ENDPHf , ,20))  AND 

1 

RT 

,**■  002940 

( S  TR(  IOBUFFP$ , ,  24  )>STR(  ENDPH$ ,  ,  24 )  )  THEN  HOME 

RT 

* 

■\  002950 

RT 

j 

002960 

KNOT: 

RT 

V  002970 

IF  W=1  THEN 

« 

RT 

r 

002980 

WRITE  |3,  USING  WDIMG5,C$,STR(  I0BUFFWS, 1,20) , 

1 

RT 

£  002990 

STR( IOB'JFFWS  ,21,20) ,STR(I08UFFW$,41,15) 

1 

RT 

■  003000 

ELSE 

1 

RT 

m-  003010 

WRITE  #3,  USING  WDIMG6,C$ ,STR( I08UFFP$, 1, 24) , 

• 

RT 

003020 

STR( IOBUFFP$ ,25,20) ,STR( XOBUFFPf  ,45,15) 

RT 

003030 

RECS%=RECS%Pl 

RT 

/ 

003040 

IF  RECS%>LPP%  THEN  RECS%=1 

RT 

003050 

TF  RECS*=1  THEN  PAGE%=PAGE*+i 

RT 

003060 

IF  WFOl  AND  W»1  THEN  READ  fi,  I08UFFW$,EOD  GOTO  FINW 

RT 

il  003070 

IP  PFOl  AND  W=0  THEN  READ  #2,  I08UFFP$,B0D  GOTO  FINP 

RT 

P  003090 

IF  STR(  lOBUFFWi, ,  20  )>  ENDPH$  THEN  WF=1 

RT 

V  00 3  LOO 

IF  3  TR  (  I08UFFP$,,  24  )>ENDPH$  THEN  PF=i 

RT 

003110 

IF  WF=1  AND  PF=1  THEN  HOME 

RT 

003120 

IP  SrR(I08UFFW$,,20)<STR(I08UFPP$,,20)  THEN  W=1  ELSE 

O 

It 

X 

RT 

*. 

003130 

IF  RECS%  =  1  THEN  QOSUB  HEADER 

RT 

003140 

GOTO  KNOT 

RT 

.* 

£  003150 

HOME:  WRITE  #3,  USING  DOG,  HEX(0002) 

RT 

■  003170 

WRITE  #3,  USING  WDIMG8,  C$ 

RT 

-  003180 

CIOSE#3 

RT 

003190 

IF  STR(TP$,1,1)  »"P"  THEN  MESS 

RT 

¥ 

003200 

CLOSE  WS 

RT 

003210 

MSG2$  =  'CANCEL  Processing" 

RT 

* 

003220 

MSK$=>HEX(  00) 

RT 

003230 

CMSG$  =  "  * 

RT 

j|  00  3240 

CALL  "LINK*  ADDR("DISPFILE*,"P",RLIB$,RVOL$,3%,PFIL$,  SLIB$, 

1 

JM 

■ 

~  003250 

SVOL$,  "C“ ,MSG2$,27%, "ri" ,MSK$,CMSG$, 255%,C% ,R%) 

JM 

7 

« 

003260 

ERS  =  "  * 

RT 

\ 

003270 

IF  Ci<>0  OR  R%00 

1 

RT 

003280 

THEN  ER$  =  STR( CMSGJ , 141 ) 

RT 

003290 

GOTO  CWMENU 

RT 

003300 

RT 

*  003310 

MESS:  ER$="  File  "4PFIL$  4"  in  LiDrary  "4  SLIB$  4"  on 

"&  : 

JM 

fl 

■  003320 

SVOI.S  4"  generated." 

JM 

1 

003330 

GOTO  8ALONET 

RT 

003340 

RT 

00  3350 

NEW:  PRINT  PAGE,  ATU  2, 28)  ,HEX(  84) ;  "Closing  last  file" 

RT 

003360 

WF,PF,W  =0 

RT 

003370 

FOR  1=  1  DO  50000  :NEXT  I 

RT 

•j 

003380 

CLOSE  1 1 :CLOSE  #2  :  OPEN%( 1) ,OPEN%( 2 ) =0 

RT 

■J 

|f  003390 

GOTO  AGAIN 

RT 

1 

™  003400 

RT 

003410 

i’TL  PGE: 

RT 

003420 

C$ -HEX (8001) 

RT 

0034  30 

»VR I TIE  <3,  USING  DOG,  C$ 

RT 

*■'  003440 

C$  =■  |1EX(  0015) 

RT 

003450 

WRITE  13,  USING  DOG,  C$ 

RT 

£  003460 

S  _ 

C$  =  HEX(OOOl) 

RT 

A 

j 

* 

1/0 

■ 

K  ’  -  •-  *- - •  A.  •_ 

* .« 

.  -  -  **  -  *  .  *  V  *  •.  -  „  -  k‘-  .  -  J 
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003470  WRITE  #3,  USIttS  DOG1,  C$  RT 

003480  WRITE  #3,  USING  DOG2,  C$  RT 

00J490  WRITE  #3,  USING  0X30,  C$,D$,Tt  RT 

003500  WRITE  |3,  USING  OOG3,  C$  RT 

003510  WRITE  #3,  USING  DOG2,  C$  RT 

003520  WRITE  #3,  USING  DOG1,  C$  RT 

003530  WRITE  #3,  USING  DOG2,  C$  RT 

003540  IF  SBTITLE*  =  "  *  THEN  GERRY  RT 

003550  WRITE  #3,  USING  OOG4,  C$,  SBTITLEi  RT 

003560  IP  SflTITLl$<>*  "  THEN  WRITE  #3,  USING  1  RT 

003570  DOG10,  C$,  SBTITL1$  RT 

003580  WRITE  #3,  USING  DOG2,  C$  RT 

003590  GERRY:  WRITE  #3,  USING  DOG5,  C$,WFILE$,PFILE$  RT 

003600  WRITE  #3,  USING  DOG2,  C$  RT 

003610  WRITE  #3,  USING  DOG6,  C$,WLIBS ,PLIBi  RT 

003620  WRITE  #3,  USING  DOG2,  CS  RT 

003630  WRITE  #3,  USING  DOG7,  C$,WVOL$,PVOl$  RT 

003640  WRITE  #3,  USING  DOG2,  C$  RT 

003650  WRITE  #3,  USING  DOG8,  C$,  STARTPH$  RT 

003660  WRITE  |3,  USING  DCX32,  C$  RT 

003670  WRITE  #3,  USING  DOG9,  C$,  END?H$  RT 

003680  WRITE  #3,  USING  DOG2,  C$  RT 

003690  WRITE  *3,  USING  DOG1,  C$  RT 

003700  RETURN  RT 

003710  RT 

003720  HEADER:  RT 

00373U  IF  PAGEi=l  THEN  FIRST  RT 

003740  C$  =  HEX(0001)  RT 

003750  WRITE  #3,  USING  DOG,  C$  RT 

003760  FIRST:  C$  =  HEX(3001)  RT 

003770  vJR I TE  #3,  USING  DOG,  C$  RT 

003780  C$  =  HEX(OOOl)  RT 

003790  IF  SBTI TLE$  =  "  "  I  RT 

003800  THEN  WRITE  »3,  USING  WD IMG , C$ , D$ , T$ ,  PAGE*  '.  RT 

003810  ELSE  GOTO  POUT  RT 

003320  GODD  ALRITE  RT 

003830  FOUT:  WRITE  #3,  USING  WDIMG1,C$,SBTITLE$,D$,T$,PAGE*  RT 

003840  IF  SBriTLlJO"  ’  RT 

003850  THEN  WRITE  *3,  USING  WDIMG7,C$,SBTITLl$  RT 

003860  ALRITS:WRITE  #3,  USING  WDIMG2,  C$,WFILE$,WLIB$,  WWL$  RT 

003870  WRITE  #3,  USING  WDD4G9,  C$,PFILE$,PLIB$,  PVOL$  RT 

003880  WRITE  #3,  USING  WDIMG3,  C$  RT 

003390  WRITE  #3,  USING  WDIMG4 ,  C$  RT 

003910  WRITE  |3,  USING  WOIMG3,  C$  RT 

003920  RETURN  RT 

003930  RT 

003940  DOGO : % # #  .'  lltiiMI  !  RT 

003950  11*11  :  RT 

003960  DOG:  %f»  RT 

003970  D0G1:%»*  ! - 1  RT 

003980  - :  RT 

003990  DOG2:m  !  RT 

004000  I  RT 

004010  DOG3.-m  :  **»**»  M£RGE  SUBSTITUTION  LISTS  :  RT 

004020  *****  :  RT 

004030  DOG4 :  %  t  *  TITLE  OF  LIST:  *l»HI*«#m»t!  RT 

004040  *1***1  :  RT 
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004050  OOG5:%t#  1  WORD  PILE  :  till!***  PHRASE  PILE  :  !  RT 

004060  lltllttl  !  RT 

004070  DOG6:%l#  !  LIBRART:  lllitlf*  LIBRARY:  !  RT 

004080  **#*##*#  !  RT 

004090  DOG7:%lt  !  VOfjJME  :  Hill*  VOLUME  :  !  RT 

004100  I  tint  :  RT 

004110  DOG8:%M  !  STARTING  WORD:  RT 

004120  »»i*»i»tti  :  RT 

004130  DOG9:%tl  !  ENDING  WORD  :  »** I **##** 1 1 1 # !  RT 

004140  I *********  !  RT 

004150  DOG10:»#»  !  1*111* I illlii:  RT 

004160  1*11*1*  !  RT 

004170  WDIMG:%»#  1*11*11*  *»*#*  1  RT 

004180  PAGE  *1*1*  RT 

004190  WDIMG1  :%lt  TITLE  OF  LIST  :  IIIIIMII *1111*11111  llltlltl  l  RT 

004200  #*##*  PAGE  till*  RT 

004210  WDIMG7 :%**  Hllltltl  t*t»!l»*lll  RT 

004220  WDIMG2:%»I  WORD  Pile  is  Ittlllfl  in  Library  *111*11*  on  Volume  #1  RT 

004230  tilt*  RT 

004240  WDIMG9:%|*  Pi  IRAS  E  File  is  tllttll*  in  Liorary  tlllllll  on  Volume!  RT 

00425U  mill  RT 

004260  WDIMG3: %ll======-=======  =  =  ====-== -=-==-=-==========■=-===-=•=======!  RT 

004270  =  =  =  =  =>=*"=*=*=■»«*»=:*  ===*  =  RT 

0U4280  WDIMG4:%»*  Word  or  Pnrase  first  SuDstitute  S!  RT 

004290  econd  Substitute  RT 

004300  WDIMG5:%tl  I II 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  1 1 1 1 1 1 1  III  1 1 II II 1 1 1 1  I!  RT 

004310  llllllimillll  RT 

004320  WDIMG6:%*|  1111111*11111111*1111111  1**1***1111*1*111*11  I!  RT 

004330  1*11*111*11*1111*111  RT 

004340  WDIMG8:%#|  ! '. '.  END  OP  LISTING  !!!  RT 

004350  RT 

004360  PINW:  IP  PF=1  THEN  HOME  RT 

004370  WF=1 :  IOaUFfW$=’ZZZ"  RT 

004380  GOTO  3070  -  RT 

004390  RT 

004400  PINP:  IP  WP=1  THEN  HOME  RT 

004410  PF=i : IOBUPPP$="ZZZ"  RT 

004420  GOIO  3090  RT 

004430  RT 

004440  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */  RT 

004450  /*  SETS  UP  PLASHING  FAC'S  IN  APPROPRIATE  PLACES  */  RT 

004460  DEP  FN'7(MSG$,B$,C$,D$)  RT 

004470  PRINT  FT 

004480  M$=HEX( 94 ) :G2$,L2$, V2$=riEX(  81 )  RT 

004490  Gl$=-B$  RT 

004500  Llfc=C$  RT 

004510  V1$=D$  RT 

004520  RETURN  RT 

004530  RT 

004540  DEP  PN ' 8 ( MSG$ , B$ , C$ , D$ )  RT 

004550  PRINT  RT 

004560  M$=HEX(94) :Git, Li$, Vi£=HEX(  81 )  RT 

004570  G2$=B$  RT 

004580  L2$=C$  RT 

004590  V2$=D$  RT 

004600  RETURN  RT 

004610  EXIT:  CIiJSE  *1  RT 


1 12 
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004620  OUT:  /*  RETURNING  TO  SUBSTI TUTION  LIST  MENU  V 
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CRES@BCG  in  library  CRES@PRC  is  the  Procedure  Language  menu  routine  that 
serves  as  the  driver  for  the  Create/Maintain  Glossary  Subsystem.  It  enables 
the  user  to  select  by  PF  key  among  options  to  create/maintain  the 
Abbreviation-Acronym  Glossary  or  the  Technical  Glossary,  to  print  the 
Abbreviation-Acronym  Glossary  or  the  Technical  Glossary,  or  to  return  to  the 
CRES  Master  Menu. 
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Page 


PROCEDURE  CRES  ABBREVIATION/ ACRONYM  GLOSSARY  MAINTENANCE  MENU  JM 

AUTHOR  ROSE  TANK  JM 

DATE  10/06/83  JM 

Abstract:  This  procedure  is  the  CRES  ABBREVIATION/ACRONYM  JM 

GLOSSARY  MAINTENANCE  MENU.  It  allows  the  user  JM 

to  select  and  run  any  Aooreviation/Acronym  JM 

Glossary  rile  option.  JM 


EXTRACT  f»USERNAMfi=USERNAME,  &RUNLI8=OUTlIB,  6RUN\£>L=RUNVOL  JM 

* 

r 

GETUSERINRT:  PROMPT  PEKEY  =  &USERINPT  CENTER 

DIM  "CRES:  Glossary  Maintenance  Subsystem  (G1 

ousary  Menu  Screen)*; 

_ _ _ _ _ _ .  _ n  m 

JIM  "  “ ; 

DIM  "  This  subsystem  will  allow  you  to  iiuintain  two  giossar  JM 

les  -  one  for  " ;  JM 

DIM  "  abbreviations  and  acronyms,  and  another  as  a  general  JM 

glossary.";  JM 

DIM  "  Select  the",  dRIGriT  'PE  Key",  "corresponding  to  your  JM 

desired  operation.";  JM 

DIM  "  ";"  " ; 

DIM  "  " ,LINE  "PE", DIM  *  ", 

LINE  '  *  Operation 

.  * ;DIM  '  "  ; 

DIM  "  ", Bright  "1“,"  -  Maintain  Abbreviation-Acron 

ym  Glossary"; 

DIM  "  ", Brignt  “2","  -  Maintain  Glossary"; 

DIM  "  ", Bright  "3","  -  Print  Abbreviation-Acronym 

Glossary* ; 

DIM  "  ",Bngtit  "4","  -  Print  Glossary"; 

JIM  "  " ; 

JIM  "  ", Bright  "16“,"  -  Return  to  CRES  Master  Menu" 

;  JIM  ’*;*";**;**;•  *; 

BRIGHT  SORT  IONERR; 

BLINK  &OPITONERR2; 


ASSIGN 
ASSIGN 
ASS  IGN 


&ERRMSG  =  " 
&OPITONERR  - 
&OPTIONERR2 


000100 

000200 

000300 

000400 

000500 

000600 

000610 

000700 

000800 

000900 


DECLARE 

MJSERINPT 

AS 

INTEGER 

INITIAL 

0 

001000 

DECLARE 

&OPTIONERR 

AS 

STRING 

(79) 

INITIAL 

m 

n 

001100 

DECLARE 

&OPT1GNERR2 

AS 

STRING 

(79) 

INITIAL 

N 

m 

001200 

DECLARE 

&USERNAME 

AS 

STRING 

(24) 

INITIAL 

m 

M 

001300 

DECLARE 

&ERRMSG 

AS 

STRING 

(34) 

INITIAL 

m 

m 

001400 

DECLARE 

&RUNLIB 

AS 

STRING 

(8) 

INITIAL 

m 

* 

JM 

001500 

DECLARE 

&RUNVOL 

AS 

STRING 

(6) 

INITIAL 

ft 

m 

.jm 

OOlbOO 

001700 

001800 

001900 

002000 

002100 

002200 

00230U 

002400 

002500 

002o0U 

002700 

002800 

002820 

003000 

003100 

003200 

003300 

003400 

003500 

003600 

003700 

003800 

004000 

004100 

004200 

004400 

004500 

004600 

004700 

00430U 

004900 

0050U0 

005100 

005200 

005300 


IE 

WJSEKINPT  EQ 

lb 

GOTO  USEREXIT 

UU54U0 

IE 

&USERINPT  EQ 

32 

GOTO  USEREXIT 

005500 

IF 

&USERINPT  EQ 

1 

GOTO  RUNBCG 

005600 

IE 

&USERINPT  EQ 

17 

GOIO  RUNBCG 

005700 

IE 

S.USSRINPT  EQ 

2 

GOTO  RUNGLO 

005800 

177 
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IF  &USERINPT  EQ  18 

GOIO  RUNGID 

005900 

IF  &USERINPT  EQ  3 

GOTO  RUNPBC 

006000 

IF  &USERINPT  EQ  19 

GOIO  RUNPBC 

006100 

IF  6.USERINPT  EQ  4 

GOTO  RUNPGL 

006200 

IF  &USERINPT  EQ  20 

GOIO  RUNPGL 

006300 

006400 

ASSIGN  &OPTIONERR  = 

"I'm  sorry,  but  your  selected  option 

006500 

is  not 

currently  avaiiaole. " 

006600 

ASSIGN  &OPTIONERR2  = 

=  "Please  select  another  topic." 

006700 

GOTO  GBIXISERINPr 

006800 

* 

006900 

RUNBCG: 

RUN  CRESOOCG  IN  &RUNLIB 

ON  &RUNVOL. 

007000 

IF  RUNBCG  EQ  0 

GOTO  GEIUSERINPT 

007100 

GO'IU  USEREXIT 

007200 

tr 

007300 

RUNGUJ: 

RUN  CHESGLOS  IN  6RUNLIB 

ON  &RUNVOL 

007400 

IF  RUNGLO  EQ  0 

GOIO  GETUSERINPT 

007500 

GOTO  USEREXIT 

007600 

* 

007700 

RUNPriC: 

run  aj!ss<!acp  in  &runlib 

ON  I.RUNVOL 

007800 

IF  RUNPBC  EQ  0 

GOTO  GETUSERINPT 

007900 

GOTO  USEREXIT 

008000 

* 

008100 

RUNpCl: 

RUN  CRESGU5P  IN  &RUNLIB 

ON  J.RUNVOL, 

008200 

IF  RUNPGL  EQ  0 

GOIO  GETUSERINPT 

008300 

GOTO  USEREXIT 

008400 

* 

008500 

USER  EX  If 

:  RETURN 

008600 
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Create/Maintain  Abbreviation/Acronym  Glossary  (CRESflBCG) 

CRES@BCG  in  library  CRES@SRC  is  the  BASIC  language  program  to 
create/maintain  the  Abbreviation/Acronym  Glossary.  The  object  language 
version  is  CRES@BCG  in  library  CRES@SAV. 

This  program  first  allows  the  user  to  specify  the  Abbreviation/Acronym 
Glossary  to  be  created  or  maintained.  Then,  the  program  enables  the  user  to 
add,  delete,  or  modify  any  given  term  in  the  glossary.  There  is  a  protection 
system  implemented,  and  provision  is  made  for  clearing  the  protect  bytes,  if 
for  some  reason  the  bytes  have  been  left  set  incorrectly. 

Each  entry  in  the  Abbreviation/Acronym  Glossary  can  contain  up  to  ZO 
characters,  a  flag  indicating  whether  it  is  an  abbreviation  or  an  acronym,  and 
a  definition.  The  data  record  description  is  provided  in  appendix  A. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart . 
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000010  /*  CRES  ABBREVIATION/ ACRONYM  GLOSSARY  SUBSYSTEM  PROGRAM  */  RT 
000020  /*  V  RT 
000030  /*  AUTHOR  :  Rose  TanK  */  JM 
000040  /*  Date:  March  12,  1984  V  RT 
000050  /*  V  RT 
000060  /*  Abstract:  This  program  is  used  to  create  and  maintain  the  V  JM 
000070  /*  CRES  Aboreviation  -  Acronym  List.  */  JM 
000071  JM 
000080  DIM  WORD$20,iX>DE$i,  ER$6S,PROTECT$3,rtESING$30  JM 
000090  DIM  F1S20, IOBUFF$i90,ERi$5Q,F2Sl0  RT 
000100  DIM  FIL£S8,USER$3,US£RNAME$24,WRKST$3  RT 
000110  DIM  HEADER$50,E$1,PF16$4,XS1  JM 
000120  DIM  ENTER$5,ILIB$8,IVOLS6,PASSWRD$ll  JM 
000130  DIM  IDFLS1»DEFS( 3)55  RT 
000140  DIM  MODSS15,ATrRS18,ENTR$16,TAB$3,BACKTAB$7  RT 
000150  A'PTRS = “ OJRR ENT  ATTRIBUTES":  ENTR$ = " LEGAL  ATIR IBUTES’  RT 
000160  TABS3  "TAB"  :  BACKTABS  "BACKTAB"  RT 
000170  ENTERS  =•  "ENTER"  RT 
000180  PF16S=*PF16*  RT 
000190  PFS  =  "PF" :  0*>ER$="  Operation"  RT 
000200  0$="  1"  :  T$=“2"  :  TH$=*3":  PT$»*14":  ST$=*"16"  RT 
000210  WELCOMES  ="Welcome  to  the*  RT 
000220  H BAD ER$= "CRES  ABBREVIATION  &  ACRONYM  MAINTENANCE  SUBSYSTEM*  RT 
000230  RT 
000240  /*  The  following  two  lines  are  used  as  formats  in  the  packing  */  RT 
000250  /*  and  the  unpacking  of  record  field  values  */  RT 
0U026U  F 1$=HEX(  A014A001A037A037A037A0030001)  RT 
000270  F2$=KEX( 008AA0030001)  RT 
000280  RT 
000290  CALL  “EXTRACT"  ADDR<*  ID" ,  USERS,  *  IL",  ILIB$,  "IV* ,  I\A3LS)  RT 
000300  RT 
UU031U  /*  SET  UP  THE  USER  FILE  BLOCK  */  RT 
000320  RT 
000330  SELECT  1 1 ,  " ABACGL" ,  VARC, INDEXED, RSCS IZE=190, KEYPOS= I , KEYLEN=2U  RT 
UU0350  '  RT 
000360  CALL  "LIMITS*  ( "ABBRELST",  ILIBS,  IVOLS, CODES)  RT 
000370  IF  COOES <>“N"  THEN  430  JM 
000380  OPEN  NOGETPARM  #i, OUTPUT,  PILE=*ABBREl2»i”,LIBRARY=lLIB$,  I  RT 
000390  VOLUME=I  WLS  RT 
000400  IOBUFF$="  ABBREVIATION/ACRONYM  GLOSSARY’  RT 
000410  CLOSE  #1  RT 
000420  RT 
000430  OPEN  NOGETPARM  #1, SHARED,  FILE=*ABBRELST* ,  LIBRARY  =ILI8$,  1  RT 
000440  VOLUME  =IVOLS  RT 
000450  RT 
000460  /*  This  section  of  code  generates  the  first  screen,  which  asks  */  JM 
000470  /*  for  the  particular  abbreviation  (or  acronym!  and  its  corres-  */  JM 
000475  /*  ponding  operation  -  either  insert  aboreviation  (acron/in),  */  JM 
000480  /*  delete  abbreviation  (acronym!,  or  modify  abbreviation  (aero-  */  JM 
000485  /*  n/m) .  The  user  is  also  given  the  option  of  returning  to  the  */  JM 
000490  /*  Glossary  Maintenance  Menu.  */  JM 
000510  RT 
000520  WORDS, KR$,ER1S=*  "  :ES=H£X(8C)  RT 
000530  X$=HEX( 81)  JM 
000540  PASSWRD$=HEX( 0001 J2030E10ill2131E20)  JM 
000550  RT 
000560  CWMENU:  RT 
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000570  ACCEPT  RT 
000580  AT  (01,03),  RT 
000590  "CRES:  Abbreviation  and  Acronym  Subsystem  (Word  &  Option  Sell  RT 
000600  ection  Screen)",  !  RT 
000610  AT  (02,03),  !  RT 
000620  •=-=-==================J====«===J^===«========«===============:  RT 

000630  ==========",  1  RT 

000640  AT  (04,10),  FAC(  HEX(  80 ) ,  1  RT 
000650  WELCOMES  ,  RT 
000660  AT  (04,26),  FAC( HEX( 85) ) ,  !  RT 
000670  HEADERS,  1  RT 
000680  AT  (06,05),  !  RT 
000690  "Please  select  an  abbreviation  or  acronym:",  )  RT 
000700  AT  (08,32),  FAC(XS),  WORDS  ,  Cri(20),  !  Jrt 
000710  AT  (10,18),  FAC(ES),  ERS  ,  CH(60),  1  RT 
000720  AT  (11,20),  FAC(E$),  ERiS  ,  CH(50),  !  RT 
000730  AT  (13,05),  1  RT 
000740  "To  continue,  select  tty:  PF  key  corresponding  to  the  desired  oper!  RT 
000750  ation. " ,  !  RT 
000760  AT  ^16, 28),  FAC( HKX( A5) ) ,  PFS  ,  Cri(02),  I  RT 
000770  AT  (16,35),  FAC( HEX( AC) ) ,  OPERS  ,  CH{31),  !  RT 
000780  AT  (18,28),  FAC ( HEX ( 84) ) ,  U$  ,  CH(01),  1  RT 
000790  AT  (18,35),  1  RT 
000800  "INSERT  arinreviat ion  or  acronym",  1  RT 
000810  AT  (19,28),  FAC( HEX( 84) ) ,  r$  ,  CH(l),  1  RT 
000820  AT  (19,35),  !  RT 
000830  "DELETE  abbreviation  or  acronym",  1  RT 
000840  AT  (20,28),  FACl  HEXl  84) ) ,  TllS  ,  CH(  1) ,  1  RT 
000850  AT  (20,35),  1  RT 
000860  “MOOIFY  abbreviation  or  acronym",  !  RT 
000870  AT  (22,28),  PAC( HEX( 84) ) ,  FIS  ,  CH(02),  1  RT 
000880  AT  (22,35),  !  RT 
000890  "Protection  Override",  I  RT 
000900  AT  (  23,26),  FAC( riEX( 84 ) ) ,  SP$  ,  Cri(02),  !  RT 
000910  AT  (23,35),  '  !  RT 
000920  "Return  to  tty*  Glossary  Maintenance  Menu",  1  RT 
000930  KEYS (  PASS WRD$ ) ,  1  JM 
000940  KEY (OP!  ION)  JM 
000950  IF  OPriON=16  OR  OPflON-32  THEN  EXIT  JM 
000960  RT 
000970  WELCOMES, HEADERS="  "  RT 
000980  ERS, ERIS  ="  ":  B$=HEX(8C)  RT 
000990  RT 
001000  /*  Cneck  cor  confirmation  of  deletion  */  RT 
001010  IF  ( OPT I(JN=  0  )  AND ( DF  =  1 )  THEN  DEL  RT 
001020  /*  o>*cK  for  cancellation  of  deletion  */  JM 
001030  IF  DF=1  THEN  UPDATE  RT 
001040  /*  Ctyck  for  override  of  protection  bytes  */  JM 
001050  IF  (OPriON=l4)  OR  (OPITON=3U)  THEN  OVERRIDE  RT 
001060  IF  STR(WURD$,1,1)<>"  "  THEN  REED  RT 
001070  RT 
001080  PRINT  BELL  RT 
001090  ERS="  Tt>_*  first  character  cannot  be  blank."  RT 
001100  ERl$=  "  Please  reenter  tt>*  appropriate  word  and  PF  key."  RT 
001110  ES=  HEX( 94 )  RT 
001120  QOTJ  CWMENU  RT 
001130  RT 
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001140  OVERRIDE:  rtT 
00  L 150  IP  NP=1  AND  P%  =  1  THEN  CliK  rtf 
001160  ER$=  "Please  clieck  it  word  exists  uy  selecting  an  option."  JM 
001170  E$=HEX(  84)  rtT 
001180  GOTO  CWMENU  rtf 
001190  rtf 
00’ 200  /*  Protection  override  is  confirmed  if  trie  protection  was  set  */  rtT 
001210  /*  by  a  user  not  currently  logged  on  or  if  tire  current  user's  */  rtf 
001220  /*  id  equals  thi  protection  bytes.  */  JM 
001230  CHK:  KT 
001240  ip  (user$=protect$)  oh  (wkkst*=-1)  then  remove  rt 
001250  ER$=  "You  don't  have  the  clearance  to  override  the  protect."  RT 
001260  E1U$="  "  Hi’ 
001270  E$=  HEX( 84)  RT 
001280  GOTO  CWMENU  RT 
001290  HT 
001300  /*  Reset  the  protection  byte  to  blanks  */  RT 
001310  REMOVE:  PrtOTRCT$=  "  *:P%=0  RT 
001320  IP  NORD$="  *  THEN  1080  JM 
001330  READ  #1,  HOLD,  KEY=WORD$, I08UPP$  HT 
001340  $PACK  ( F=P IS)  I08UFF$  FROM  WOK0$,1DPU,  DEP$(  1)  ,DEP$(  2) , RT 
00 1 350  DEF$(  3 ) ,  PROTECTS  RT 
001360  REWRITE  1 1 ,  IO!3UFF$,  DATA  GOTO  IOERR2  RT 
001  1/0  ER$=*  "  You  may  now  select  your  option."  rtT 
001380  EHi$ -  "  "  KT 
001190  E$=  HEX(84)  RT 
00140U  GOTO  CWMENU  rtf 
001410  RT 
001420  I 00882:  PRINT  RT 
001410  PRINT  HEX( 94), "Error  occurred  on  tile  * ;  FILES  RT 
001440  PRINT  8HX( 94), "Error  code  -  ";  PS ( 1 1 )  RT 
001450  STOP  "Touch  ENTER  to  return  to  menu."  RT 
0U146O  GOTO  CWMENU  RT 
001470  RT 
001480  /*  Error  message  is  i 'tinted  it  "feNTER"  was  hit  before  die  option*/  RT 
UU149U  /*  was  entered  */  RT 
001500  REED:  IP  OPTIONOO  THEN  SRCH  RT 
001510  EH$=  "  Command  missing."  RT 
001520  E$=  HEX( 94)  RT 
UU1510  GOTO  CWMENU  RT 
0015)0  SRCH ;  1*4=1 

001540  READ  »l,HO(X),KEY=VWRD$,IOBUPF$,EOO  GOTO  ilOTPOUND,  !  RT 
001560  DATA  GOTO  IOERR2  RT 
0014/0  RT 
001580  NF  I  /*  Th*  word  was  lound  */  RT 
001540  RT 
UIH60U  /*  Unpack  and  ctieck  i£  currently  being  nibdified  by  anotlier  */  RT 
001610  RT 
001620  SUNPACK  (P=K1$)  IOBUFF$  TO  WORD$, IDFL$,DEF$( 1 ) ,DEF$( 2) ,  RT 
0016  30  DEF$(  3),  PROTECTS  RT 
001640  IP  PR(7TECT$=  *  “  THEN  NOW  RT 
001650  CALL  "FINDUSErt"  ADDR (  PROTECTS , USERNAMES ,  WRKST4  )  RT 
001660  CONVERT  W RKST%  TO  WRKST$,  PIC  HID  RT 
01)16/0  E$=  HEX(  94 )  RT 
001680  EK$="  Sorry,  "4  USERNAMES  4"  is  currently  editing  "  HT 
001690  EH  1$=’  '"Si  WUrtD$  &  ”  "  &  "  at  worx.stdtion  "4  Wi«ST$  RT 
001/00  REWRITE  #i,XOi3UPF$  RT 
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001710  GOTO  CWMENU  RT 
001720  RT 
001730  /*  Set  the  protection  uytes  */  JM 
001740  NOW:  PROTECTS^  0SER$  RT 
001750  SPACE  (F=P1$)  IOflUFFS  FROM  WORDS,  IDFLS,  DEF$ ( 1 ) , DEF$ (2)1  RT 
001760  , DBFS (3), PROTECTS  RT 
001770  REWRITE  11,  I03UFFS,  DATA  GOTO  IOERR2  RT 
001780  RT 
001790  /»  NOW  BRANCH  ID  THE  OPTION  SELECTED  */  RT 
001800  OPT:  ON  OPTION  GOTO  INSERT, DELET, MODIFY  RT 
001810  ON  OPTION-16  GOTO  INSERT, DELET, MODIFY  RT 
001820  RT 
001830  NOTFOUND:  NF»0  /*  The  word  was  not  round  in  the  list  */  RT 
001840  GOTO  OPT  RT 
001850  RT 
001860  INSERT:  RT 
001870  /*  NF=0  indicates  the  word  doesn't  yet  exist  so  go  ahead  */  RT 
001880  /*  and  insert.  NF=1  indicates  the  word  exists.  */  RT 
001890  IF  NF=1  THEN  EXIST  RT 
001900  MOQE$=  "(Insert  Screen)"  RT 
00190L  MESINGS*" inserting  aDoreviation/acronym"  JM 
001910  IDFLS, D£F$( )="  "  RT 
001920  IOBUFPS*"  “:  PROTECTS*  USERS  RT 
001930  SPACK  ( F=F 1$ )  IOBUFFS  FROM  WORDS,  IDFL$,DEP$( 1) ,DEF$(  2) ,  1  RT 
001940  D£F$(  3), PROTECTS  RT 
001950  WRITE  #1,  IOBUFF$,  DATA  GOTO  IOSRR2  RT 
001960  GOTO  INS  RT 
001970  RT 
001980  /*  Coming  irom  insert  with  the  word  currently  existing,  */  RT 
001990  /*  print  an  error  message  and  erase  the  protection  oytes  */  JM 
002000  EXIST:  RT 
002010  £R$=  "  ' "  &  WORDS  &  "'  already  exists  in  this  list."  JM 
002020  ES»  HEX( 94)  RT 
002030  READ  »1,  HOLD,  KE¥=  WORDS, IOBUFFS  RT 
002040  PROTECTS*"  "  :P%=0  '  RT 
002050  SPACK  (F=F1$)  IOBUFF$  FROM  WORDS,  IDFLS, DEFS(  1)  ,DEFS(  2) ,  '.  RT 
002060  DEFS(  3),  PROTECTS  RT 
002070  REWRITE  #1,  IOBUFFS,  DATA  GOTO  IOE1R2  RT 
C02080  GOTO  CWMENU  RT 
002090  RT 
002100  /*  DELET, DEL, NODEL-  all  pertain  to  toe  delete  option  */  RT 
002110  /*  DELET-  gives  the  user  a  chance  to  cancel  the  deletion  */  RT 
002120  DELET:  IF  NF=0  THEN  NODEL  RT 
002130  DF=1  RT 
002140  ERS=  "  Press  ENTER  to  confirm  deletion  of  ’&  WORDS  JM 
002150  ERIC*"  or  press  PF14  to  cancel  deletion."  JM 
002160  XS=HEX( 84)  JM 
002170  PASSWRD$=HEX( 000E1E)  JM 
002180  E$=  HEX(94)  RT 
002190  GOTO  CWMENU  RT 
U02200  RT 
002210  /*  DEL-  deletes  the  entire  record  */  RT 
002220  DEL:  READ  # 1 ,  HOLD, KEY=NORDS, IOBUFFS  RT 
002230  DELETE  #1  RT 
002240  DF--0  RT 
002250  ER$=  *  '"iWORDSi"'  deleted  -  Please  continue."  JM 
002260  X$=HEX(8i )  JM 
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0022/0  PASSWRD$=HEX( 0001020 30E1011 12 131E20)  JM 
002280  NF= 0  JM 
002290  £ $=  HEX(8C)  JM 
002300  NORD$="  *  RT 
002310  GOTO  CWMENU  RT 
002320  RT 
002330  /*  NOOEL-  print  an  error  message  when  the  word  doesn't  exist  */  RT 
002340  MODEL,:  ER$=  "  "&  kJORD$  &  *'  does  not  exist  in  tnis  list."  JM 
002350  E$=  HEX( 94)  RT 
002360  GOTO  CWMENU  RT 
002370  RT 
002380  MODIFY :  IF  NF=1  THEN  GET  I  T  RT 
002390  /*  if  word  not  in  list,  */  RT 
002400  ER$=  "  Modification  request  denied  -*  JM 
002410  KRL$  ="  “MORD$&‘  does  not  exist  in  this  list."  JM 
002420  E$=HEX(94)  /*  set  up  message  and  fac  and  */  RT 
0024  30  GOTO  CWMEMU  /*  go  back  up  to  previous  screen  */  RT 
002440  RT 
0U2450  GETIT:/*READ  #1, HOLD, KEY=NORD$, IOBUFF$, EOO  GOTO  NOTFOUNO,  */  RT 
002460  ^*DATA  GOTO  IOERR2  */  RT 
002470  RT 
002480  MODE$  =* (Modify  Screen)"  RT 
002481  MESING$="iiKxlifying  abbreviation/acronym"  JM 
002490  INS:  RT 
002500  ER1$  ’  RT 
002510  RT 
002520  /*  This  accept  statement  generates  a  screen  with  the  attributes  */  RT 
002530  /*  corresponding  to  each  abbreviation  (acronym)  appropriately  */  JM 
002535  /*  labeled  for  insert  or  modification.  */  jm 
002570  RT 


002580 

002590 

002600 

002610 

002620 

002630 

002640 

AOK: 

ACCEPT 

Al’  (01,03), 

"CKES:  Abbreviation  and  Acronym  Subsystem", 

AT  (01,66),  FAC( HEX( 80  ) ,  MODE$ 

AT  (02,03), 

,  CH( 15) , 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

002660 

RT 

002670 

AT  (04,06), 

RT 

002680 

"Please  enter  the 

appropriate  attributes.". 

RT 

002690 

AT  (07,  33), 

FAC (HEX (AC) ) , 

A  T  IRS 

,  Cri( 18) , 

RT 

002700 

AT  (07,60), 

FAC( HEX (AC) ) , 

ENTRS 

,  CH( 16) , 

RT 

002710 

AT  (08,06), 

RT 

002720 

"ABBREVIATION  OR  ACRONYM:", 

RT 

002730 

AT  (09,33), 

FAC( HEX(  85) ) , 

WDRD$ 

,  CO( 20) , 

RT 

002740 

AT  (11,06), 

RT 

002750 

"IDENTIFICATION  FLAG:’, 

RT 

002760 

AT  (11,33), 

IDFLS 

,  CH(01), 

RT 

002770 

AT  (11,60), 

RT 

002780 

"B=  Abbreviation", 

RT 

002790 

AT  ( 12,60), 

RT 

002800 

*C=  Acronym", 

RT 

002810 

AT  (14,25), 

FAC( E$ ) , 

er$ 

,  CH( 50) , 

RT 

002820 

AT  (16,06), 

RT 

002830 

"DEFINITION:", 

RT 

002840 

AT  (  16,20), 

FA C( HEX(  81) ) , 

DEF$(i) 

,  CH( 55), 

RT 
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002850 

AT  (17,20),  FAC(HEX(81) ),  DEFS(2)  , 

CH( 55) , 

RT 

002860 

AT  (J.8,20),  FAC(HEX(81)),  DEF${3) 

CH(55), 

RT 

002870 

AT  (21,16), 

RT 

002880 

"Use*, 

RT 

002390 

AT  (21,20),  FAC(HEX(85) ) ,  TABS  , 

CH( 03) , 

RT 

002900 

AT  (21,24), 

RT 

002910 

"or* , 

RT 

002920 

AT  (21,27),  FAC( HEX (85)),  BACKTABS  , 

CHI  07), 

RT 

002930 

AT  (21,35), 

RT 

002940 

"to  move  between  modifiable  fields.", 

RT 

002950 

AT  (23,30), 

RT 

002960 

"Press", 

RT 

002970 

AT  (23,36),  FAC(HEX(85) ) ,  ENTERS  , 

Cri(05) , 

RT 

002980 

AT  (23,42), 

RT 

002990 

"to  continue". 

JM 

003000 

AT  (24,13), 

JM 

003010 

"Press", 

RT 

003020 

AT  (24,19),  FAC( 8EX( 84) ) ,  PF16S  , 

CH( 04) , 

JM 

003030 

AT  (24,24), 

JM 

003040 

“to  exit  without  ", 

JM 

003041 

AT  (24,40),  FAC( HEX(  80  ) ,  MESINGS, 

JM 

003050 

KEYS(BIN(0) &BIN( 16) &0IN( 32) ) , 

RT 

003060 

ON  (BIN( 16) &BIN( 32) )  GOTO  EXIOM, EXIOM 

RT 

003070 

RT 

003080 

ER$»"  ":  E$=*HEX(8C) 

RT 

003090 

/*  Check  for  validity  of  entries  */ 

RT 

003100 

RT 

003110 

IF  POS(*BC"=IDFL$)>0  THEN  NEXT2 

RT 

003120 

ER$  =  "  Identification  flag  ls  illegal." 

RT 

003130 

E$  =«  HEX(  94) 

RT 

003140 

GOTO  AOK 

RT 

003150 

RT 

003160 

NEXT2:  IF  DEF$(1)<>“  ’  THEN  UPDATE 

RT 

003170 

ERS  =»  "Please  enter  your  definition  starting  on  line  1." 

RT 

003180 

ES  =  HEX( 94) 

RT 

003190 

GOTO  AOK 

RT 

003200 

RT 

003210 

/*  EXIOM  is  used  to  abnormally  exit  the  insert  node 

and  */ 

RT 

003220 

/*  NOCHAN  is  used  to  aonornvally  exit  the  modify  rode  */ 

RT 

003230 

EXIOM:  READ  fl,  HOLD,KEY=4*3RD$,  IOBUFFS 

RT 

003240 

IF  NF=1  THEN  NOCHAN 

RT 

003250 

DELETE  #1 

RT 

003260 

ERS=  “  "&WDRDS6"  was  not  inserted." 

RT 

003270 

GOTO  CWMENU 

RT 

003280 

RT 

003290 

NOCHAN:  PROTECTS  =  "  ":P%=0 

RT 

003300 

SPACK  (F=F2$)  IOBUFFS  FROM  PROTECTS 

RT 

003310 

REWRITE  |1, IOBUFFS, DATA  GOTO  IOERR2 

RT 

003320 

ER$=  "  No  changes  were  saved." 

RT 

003330 

ER1$="  " 

RT 

003340 

GOTO  CWMENU 

RT 

003350 

RT 

003360 

/*  UPDATE  removes  the  protection  on  the  record  and 

writes  out  */ 

RT 

003370 

/♦the  final  data  as  input. 

V 

JM 

003380 

UPDATE:  READ  #1,  HOLD,  KEY=W0RD$,  IOBUFFS 

RT 

003390 

PROTECTS  =  *  " :P%=0 

RT 

003400 

SPACK  (P=F1S)  IOBUFFS  FROM  WORDS, IDFLS,DEF$( 1) ,DEF$( 2) , 

RT 

186 
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003410 

003420 

003430 

003440 

003450 

003460 

003470 

003480 

003490 

003500 

003510 

003520 

003530 

003540 

003550 

003560 

003570 

003580 

003590 

003600 

003610 

003620 

003630 

003650 


DEF$(  3 ) ,  PROTECTS 

REWRITE  #1 , IOOUFFj ,DATA  GOTO  IOERR2 
ERl$=  *  " 

IF  NP=0  T8EN  RITE  /*  NF=0  indicates  insert  mode  */ 

IF  DF=1  THEN  EXDEL  /*  DP=1  indicates  delete  mode  */ 

/*  otherwise  in  modify  mode  */ 
ER$=" 1  "hlTORDSs." '  modifications  updated  -  Please  continue." 
E$=HEX(8C) 

WORD$="  " 

GOTO  CWMENU 

RITE: 

ER$  "  1  “sWORDSi."*  i nserted  -  Please  continue." 

F.$=  IIEX(BC) 

WORDS  =  *  * 

GOTO  CWMENU 

EXDEL:  DF=0 

X$=11EX(  81 ) 

PASSWRD$=HEX ( 000 10 20 30E10 1 1 1 2 1 3 1 E20 ) 

ER$  f="  Deletion  cancelled." 

GOTO  CWMENU 

EXIT:  CLOSE  »1 

/*  RETURN  TO  AdUREVI  A  IT  ON/ACRONYM  GLOSSARY  MENU  */ 


Technical  Report  80-OOI 


Create/Main^ain  Technical  Glossary  (CRESGLOS) 

EREbGLUS  in  I  ibrary  CKESOSRL  is  the  BASIC  language  program  to 
create/inaintain  the  Technical  Glossary.  The  object  language  version  is 
CRESGLOS  in  library  CRES0SAV. 

This  program  first  allows  the  user  to  specify  the  Technical  Glossary  to  ue 
created  or  maintained.  Then,  the  program  enables  the  user  to  add,  delete,  or 
modify  any  given  term  in  the  glossary.  There  is  a  protection  system 
implemented,  and  provision  is  made  for  clearing  the  protect  bytes,  if  for  some 
reason  the  bytes  have  been  left  set  incorrectly. 

Each  entry  in  the  Technical  Glossary  can  contain  up  to  20  characters, 
identification  of  up  to  three  Technical  Word  Lists  on  which  it  appears,  a  flag 
indicating  whether  it  is  a  "Mandatory  Technical  Word"  (one  which  is  so  basic 
to  the  particular  technical  area  in  which  it  is  used  that  it  is  counted  as  a 
single  syllable  in  reading  grade  level  determinations),  and  a  definition.  The 
data  record  description  is  provided  i n  appendix  A. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
f lowchart . 


AD-A168  681  COMPUTER  READABILITY  AMO  EDITING  SYSTEM  <CRES> 

PROGRAMMER'S  REFERENCE  MANUAL <U>  NAVAL  TRAINING  SVSTEHS 
CENTER  ORLANDO  FL  S  R  SCHALOH  ET  AL.  JAN  86 


UNCLASSIFIED  NAVTRASVSCEN-TR-86-881 


Technical  Report  86-001 


THIS  PAGE  INTENTIONALLY  LEFT  BLANK 


ieclmicdl  Report  db-UU] 


Wang  VS  I n t  ngr a  tnd  tditnr  -  Version  6.10.00  I X  : SO  10/30/84  Pagn 
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00  (X)  10  /*  HUS  lit  ft  K  Al  GLOSSARY  SUBSYSTEM  PROGRAM  V  RT 

000020  /*  */  RI 

00003(1  /*  AUTHOR  :  Rosn  Tank  */  JM 

000040  /»  Datn:  Mjrch  IP,  1084  */  RT 

000050  /*  */  R 1 

000060  /*  Abstract:  Ibis  program  is  uspd  to  crnatP  and/or  maintain  */  JM 

000061  /*  Uip  GRES  Glossary  of  Inchmeal  Words.  */  J4 

a)  007  0  R1 

0000 HO  HIM  W0IT0$2U,(.d0t$l  ,  t(l$65 , 1'llUi  1 L I  $3  ,M  1  WF  L  $  1  Rf 

00CKW0  DIM  1 1  $20, 10BUFF$215,ER l$50,F2$10,IL IB$B, I V0L$6  RT 

000)00  HIM  F  II  $  (3  )8 , USE R$3, U 5E RNAME $24, WRKST $3  RT 

000110  DIM  HEADER$40,PF16}4  R1 

000120  OIM  ENTERJ5, X$ I  ,MCSI  NG$  14  JM 

000130  OIM  0EF$  (3  ) 55,PASSWRO$  1  I  JM 

000140  DIM  M00E$1  5 , CURREN T_A TTR$ 1 8, TAB $3 .BACK T AB}7  RT 

000150  CURIIENT_ATTR}=  "CURRENT  ATTRIBUTES"  RT 

000160  TA8$--"TAB":  BACXT A8$="BACKT AB"  R1 

00017  0  ENTERS-  "tNIEK"  RT 

000180  Pri6$=,,PI  I6"  RT 

000)00  PI  J=  "PF  " :  OPE R $  "  Operation"  RT 

000200  0$"!":  TJ-'V":  JH$*"3“:  IIJ=-"|4":  Si  16"  RT 

000210  WEI  COMI  $  -  "Wp  I cinip  to  thn"  RT 

000220  HEADER?  "CRES  GLOSSARY  MAINTENANCE  SUBSYSTEM"  RT 

000210  RT 

00024(1  /*  IMp  following  two  linos  am  o'naj  as  f  ormut  S  >n  ton  packing  */  RT 

00025U  /*  and  thn  unpacking  of  rorord  tinld  valims  */  111 

(M10260  I  IJ=lll  X(  AOl4AO(l<AO(JiA()(»tAb3/ AO.l/AU  1/AIX)IAU03U002)  RT 

1X1027  0  F.'$-!IEX(UOD?A(X) 30002)  Kl 

000280  RT 

UtlOPTU  CAU  "EXTRACT"  AP0R("  10"  ,USER$ , "  IL" ,  1 L  18$ , "  1 V",  I  V0L$ )  Kl 

000300  R I 

0003 10  /*  SET  IIP  THE  USER  FILE  BLOCK  */  RT 

000320  RT 

000330  STLLCT  x  1 ,  "GLOSSY" ,  VARC ,  INDEXED  ,RECS  IZE  =2 1 5  ,KE  YP0S=  I  ,KE  Yl.t  N=2()  Kl 
000340  -  RT 

000350  CALL  "L IMI  TS"  ( "GLOSSARY" ,  IL  IBJ ,  I  VOl  $ ,CODE$  )  R1 

000360  IF  rODf$="Y"  I  HI  N  4  30  RT 

000370  OPt  N  NOGtIPAKM  XI,  UUIPUT,  F  1 LE ^ "GLOSSARY" ,L IBRARY- 1 L  18$ ,  I  RT 

000380  VOLUME  1  VOL  $  RI 

0003° 0  IOBUFE$  =  "  CRTS  Gl  OSSARY"  RT 

000400  WRI  It  XI,  iuBUKF  $  RT 

000410  CLUSEXI  Rl 

000420  111 

000430  DPI  N  NIXil  I  I’AIIM  XI, SHAHID,  I  1 1  I  -”G1  OSSAK  Y" .  I  IBRARY  -1118$,  I  RT 

IMXI44H  VIII  I  IMI  IVDI  $  RT 

0004  Si  I  RT 

000460  /*  Ibis  shi.  lain  of  cud*1  gpiiprdtns  the  first  scronn,  wlucn  asks  */  oM 

00U470  /*  for  thn  particular  word  and  its  corrpspondi ng  oppration  -  */  JM 

0  004  80  /*  n’thpr  msprt  word,  dp|ptp  word,  or  modify  word.  IMp  user  is  */  RT 

(X)04d0  /*  also  at  tfiis  point  givnn  thn  option  of  returning  to  thn  */  ,M 

COD500  /*  Glossary  Maintnnancn  Mnnu.  */  JM 

000510  RT 

OUTBID  WOR0$,f  R$, F  Kl$="  "  :  (  $=  HE  X  (HC  )  RT 

000521  X$  H E  X ( 8 1  )  ,M 

OOliS  V  PASS  WK  f)$  =  llf  XilXlOIO.-’fUlll  101  I  121 J  IF  >11)  JM 

0005.10  Rl 

00  054D  CVKEMJ:  RT 
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000550 

ACCEPT 

RT 

000560 

AT  (01,03), 

RT 

00  0  57  0 

"CRES:  Glossary  Maintenance  Subsystem 

(Word  6  Option  Sel 

RT 

000580 

ection  Screen)", 

RT 

000590 

AT  (02,03), 

RT 

000600 

"  ==  SC  83=  ==  ==  =  =  ==  S=S  =  ==  ===  ====  = 

-  - -  ==  = 

- =_=__=_  =  =  =  =  =====  = 

RT 

000610 

~  » 

JM 

000620 

AT  (04,15),  FAC  ( HEX  ( 8  C)  ) , 

RT 

000630 

WE  L  COME  $ 

RT 

000640 

AT  (04,31),  F AC ( H EX ( 85 ) ) , 

RT 

000650 

HEADER J , 

RT 

000660 

AT  (06,05), 

RT 

000670 

"Please  select  a  word:", 

RT 

000680 

AT  (08,32),  FAC(XJ), 

WORD} 

.  CH( 20) , 

JM 

000690 

AT  (10,18),  FAC(E$), 

ER$ 

,  CH(60) , 

RT 

000700 

AT  (11  ,20),  FAC(E$), 

ER1  $ 

,  C H( 50) , 

RT 

000710 

AT  (13,05), 

RT 

000720 

"To  continue,  select  the  PF  key  corresponding 

to  the  desi red  oper 

RT 

00  07  30 

at  ion.". 

RT 

000740 

AT  (16,28),  FAC ( HEX( A5) )  , 

PF$ 

,  CH(02) , 

RT 

0007  50 

AT  (  (6,35) ,  FAC ( HE X ( AC ) ) , 

0PER5 

,  CH(31 ) , 

RT 

0007  60 

AT  (18,28)  ,  FAC( HE X(84 ) ) , 

OJ 

,  CH(01), 

RT 

000770 

AT  (18,35), 

RT 

0007  80 

"INSERT  a  technical  word  ", 

RT 

000790 

AT  (19,28),  FAC(HEX(84 ) ) , 

T* 

,  CH( 1 ) , 

RT 

000800 

AT  (19,35), 

RT 

000810 

"DELETE  a  technical  word  ", 

RT 

000820 

AT  (20,28),  FAC (HEX(84) ) , 

TH$ 

,  CH  ( 1 ) , 

RT 

000830 

AT  (20,35), 

RT 

000840 

"MODIFY  a  technical  word  ", 

RT 

000850 

AT  (22,28),  FAC  ( HE  X  (8  4 ) ) , 

FT  $ 

,  CH (02 ) , 

RT 

000860 

AT  (22,35), 

RT 

00087  0 

“Protection  Override", 

RT 

000880 

AT  (23,28),  F  AC(  HEX(84) )  , 

ST$ 

,  CH(02 ) , 

RT 

000890 

AT  (23,35), 

RT 

000900 

"Return  to  the  Glossary  Maintenance  Menu", 

RT 

000910 

KEYS(PASSWRD3) , 

JM 

000920 

KEY(OPTION) 

JM 

0009 30 

IF  OPT I ON  =  1  6  OR  OPT  I0N=32  THEN  EXIT 

JM 

0009  4  0 

RT 

000950 

WELCOME J, HEADER**"  " 

RT 

0009  6  0 

ER$,ER1$  ="  ":  E  $ = HE X ( 8C ) 

RT 

00097  0 

RT 

000980 

/*  Check 

for  confirmation  of  deletion  */ 

RT 

000990 

IF  ( OPT  ION =0) AND ( OF  =  1 )  THEN  DEL 

RT 

001000 

/*  Check 

for  cancellation  of  deletion  */  JM 

001010 

IF  DF *  1  THE N  UPDATE 

RT 

001020 

/*  Check  for  override  of  protection  byte  */  RT 

001030 

IF  ( OPT ION=  1 4  )  OR  ( OPT  ION *30 >  THEN 

OVERRIDE 

RT 

001040 

IF  STR( WORDS,  1 ,  1  X>"  “  THEN  REED 

RT 

001050 

RT 

001060 

PRINT  HE  LI 

RT 

001070 

ERJ*"  The  first  character  cannot 

be  blank." 

RT 

001080 

ER)J  =  "  Please  reenter  the  appropriate  word 

and  PF  key." 

RT 

001090 

E HE X (94  ) 

RT 

001100 

GOTO  CWMENU 

RT 

0011 10 

RT 
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001680  GOTO  CWMENU  RT 

001690  RT 

001700  /*  Set  the  protection  byte  */  RT 

001710  NOW:  PROTECTS  USER*  RT 

001720  SPACK  (F=F  1  $)  IOBUFFS  FROM  WORDS, FIL  J(  1 )  ,FIL*(  2)  ,FI  L$(3)  I  RT 

001730  ,DEF$(1),CEF$(2),DEF$(3),MTWFLJ, PROTECTS  RT 

001740  REWRITE  #1,  IOBUFF},  DATA  GOTO  I0ERR2  RT 

001750  RT 

001760  /*  NOW  BRANCH  TO  THE  OPTION  SELECTED  */  RT 

001770  OPT:  ON  OPTION  GOTO  INSERT, OELE  T.MOD  IFY  RT 

001780  ON  OPTION-16  GOTO  INSERT, DELET.MODIFY  RT 

001790  RT 

001800  NOTFOUND:  NF*0  /*  The  word  was  not  found  in  the  list  */  RT 

001810  GOTO  OPT  RT 

001820  RT 

001830  INSERT:  RT 

001840  /*  NF=0  indicates  the  word  doesn't  yet  exist  so  go  ahead  */  RT 

001850  /*  and  insert.  NF=  1  indicates  the  word  exists.  */  RT 

001860  IF  NF-I  THEN  EXIST  RT 

001870  MODES1  "(Insert  Screen)"  RT 

00187  1  MESING$*"i  nserting  word"  JM 

001880  FIL  $( )  ,DE  F$  ( )  ,MTWF  LS“"  “:PX»0  RT 

001890  IOBUFF J= "  ":  PROTECTS  USERS  RT 

001900  SPACK  ( F  =F  1  S)  I08UFFS  FROM  WORDS, F ILS(  I )  ,F  I  LS  (2) , FILS(  3 ) ,  I  RT 

001910  DEFS(1).DEF}(2),DEFS(3),MTWFLS, PROTECTS  RT 

001920  WRITE  #1,  IOBUFFS,  DATA  GOTO  I0ERR2  RT 

0019  30  GOTO  INS  RT 

001940  RT 

001950  /*  Coming  from  insert  with  the  word  currently  existing,  */  RT 

001960  /*  print  an  error  message  and  erase  the  protection  byte  */  RT 

001970  EXIST:  RT 

001980  ERS*  "The  word  &  WORDS  &  already  exists  in  this  list."  RT 

001990  ES=  HEX  (94)  RT 

002000  READ  XI,  HOLD,  KEY=  WORDS, IOBUFFS  RT 

00  2010  PROTECTS3"  ":PX=0  -  RT 

002020  SPACK  { F  =F  1 S )  IOBUFF  S  FROM  WORDS  ,F  I  LS(  1 )  ,F  ILS  (2)  .FILS  (3 ) ,  !  RT 

002030  DEFS(1),DEFS(2),0EFS(3),MTWFLS, PROTECTS  RT 

002040  REWRITE  XI,  IOBUFFS,  OATA  GOTO  I0ERR2  RT 

0020  50  GOTO  CWENU  RT 

002060  RT 

002070  /*  UELET.DEL.NODEL-  all  pertain  to  the  delete  option  */  RT 

002080  /*  DELET-  gives  the  user  a  chance  to  cancel  the  deletion  */  RT 

002090  OELE  T :  IF  NF»0  THEN  NODEL  RT 

002100  DF=  1  RT 

002110  ERJ-  ”  Press  ENTER  to  confirm  deletion  of  ”&  WORDS  RT 

002120  ER1S'"  or  enter  PFI4  to  cancel  deletion."  RT 

002121  X J  =  HE  X (84 )  JM 

002122  PASSWRUS'HE  X(000E  I E )  JM 

002130  ES=  HE X (94 )  RT 

002140  GOTO  CWMENU  RT 

(XI 2  1 50  RT 

002160  /*  DEL  -  deletes  the  entire  record  */  RT 

002170  DEL:  READ  XI,  HOLD,  KEYWORDS,  IOBUFFS  RT 

002180  DELETE  XI  RT 

002190  DF-0  RT 

002200  ER$» . &WORDS&'"  deleted  -  Please  continue."  JM 

002210  ES=  HEX(BC)  JM 
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002211  X$  =  EC  X  ( 8 1 ) 

002212  PASSWRD$=H£X(000102030E  101 1 121 3IE20) 

002220  WOR DJ="  “ 

002221  ff«0 

002230  GOTO  CVWENU 

002240 

002250  /*  NODEL-  print  an  error  message  when  the  word  doesn't  exist  */ 
002260  NOOEL:  ERJ=  WORD*  &  does  not  exist  in  this  list." 

002270  E$=  HE  X(94 ) 

002280  GOTO  CWMENU 

0022*30 

002300  MOOIFY:  IF  NF  =  1  THEN  GET1T 

002310  /*  'f  word  not  in  list,  */ 

002320  ER}=  "  Modification  request  denied 

002  330  ER1J  =W0R0{&"  does  not  exist  in  this  list." 

002340  E S  =HE X (9 4 )  /*  set  up  message  and  fac  and  */ 

0  02350  GOTO  CVMENU  /*  go  back  up  to  previous  screen  */ 

002360 

002370  GET  IT :/*READ  4  I  .HOLD,  K£  Y-WORDJ,  I08UFF$,E00  GOTO  NOTFOUND,  */ 
002380  /‘DATA  GOTO  I0ERR2  */ 

002390  ' 

002400  MODE*  ^"(Modify  Screen}" 

002405  MESINGS  ^"modifying  word” 

002410  INS: 

0024  20 

002430  /*  This  accept  statement  generates  a  screen  with  the  attributes 
00244  0  /*  corresponding  t''  each  word  appropriately  labeled  for  insert 
00  2  4  50  /*  or  modification. 

002460 
00247  0  AOK : 

0024  80 

002490  ACCEPT 

002500  A I  (01,03), 

002510  "CHE  S :  Glossary  Subsystem  ",  AT  (01, 66) ,  FAC  (HEX  (80)  .MODE}, 
002520  AT  (02,03), 

002530  =  —  =  =  —  -  = 

002540  ====  =  ====  =  =  ===", 

002550  AT  (04,03). 

002560  "  Please  enter  the  appropriate  attributes.", 

002570  AT  (07,05), 

0025R0  "WORO:", 


00  2590  AT  (07,14), 

002600  AT  (10,06), 

002610  "APPEARING  ON  WOKO 

FAC(HEX(65))  . 

1  1ST (S) :  I)", 

WORD* 

.  CH( 18) , 

002620 

002630 

00264  0  "?)" 

AT  (10,36), 
AT  (  10,48) , 

♦ 

FAC (HE  X(8  1  ) )  , 

FILJ(I) 

,  CH(08). 

002650 

002660 

00267  0  " 3 ) " 

AT  (10,51), 
AT  (10,63), 

FAC(HEX(81  )), 

FILJ(2) 

.  C  H ( 08 ) , 

00  2  680 
002690 

0027  00  "oef: 

AT  (10,66), 
AT  (12,05), 
INIT10N: ", 

f  AL(  HE  X  ( 8 1  ) )  , 

F  I L  t(  3 ) 

,  CH(08 ) , 

0027  10 

A!  (12,19), 

FAC (HE  X (8 1 ) ) , 

OEFJ(I) 

,  CH ( 5 5 ) , 

0027  20 

AT  (13,19), 

E AC ( HE X (8 1  )  ) , 

OEF  £( 2 ) 

,  C  H  ( 5  5 ) , 

002730 

0027  40 

AT  (14,19), 
AT  (16,05)  , 

FAC (HE  X ( 8 1 ) ) , 

0EF$(3) 

.  CH( 55) , 

JM 

JM 

RT 

RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
JM 
RT 
RT 
*/  RT 
*/  RT 
*/  RT 
RT 
RT 
RT 
1  RT 

:  rt 
:  rt 

I  RT 
=  L  RT 
1  JM 

;  rt 
:  rt 
:  rt 

'.  RT 
:  rt 

1  RT 

\  rt 
:  rt 
:  rt 

I  RT 

:  rt 
:  rt 
:  rt 

.'  RT 

:  rt 
:  rt 
:  rt 
:  rt 
:  rt 

1  RT 
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0027  50  “MANDATORY  TECHNICAL  WORD:",  RT 

002760  AT  (16,36),  F  AC  ( HE  X  ( 8 1 ) ) .  MTWFLS  ,  CH(01),  1  RT 

002770  AT  (16,44),  1  RT 

002780  “(Legal  entries  are  1  '  or  •*•)“,  1  RT 

002790  AT  (18,15),  FAC(ES),  ER$  ,  CH(55),  i  RT 

002800  AT  (20,15),  I  RT 

002810  “Use”,  I  RT 

002820  AT  (20,19),  FAC(HEX(85) ) ,  TABS  ,  CH(03),  1  RT 

002830  AT  (20,23),  I  RT 

002840  “or",  1  RT 

002850  AT  (20,26),  FAC(HEX(85 ) ) ,  BACKTABS  ,  CH(07),  I  RT 

002860  AT  (20,34),  I  RT 

002870  "to  move  between  modifiable  fields.",  I  RT 

002880  AT  (23,30),  !  RT 

002890  “Press”,  I  RT 

002900  AT  (23,36),  FAC(HEX(85) ) ,  ENTERS  ,  CH(05),  RT 

002910  AT  (23,42),  RT 

002920  "to  continue",  RT 

002930  AT  (24,21),  I  JM 

002940  "Press",  ,  I  RT 

002950  AT  (24,27  ),  FAC(HEX(84 ) ) ,  PF16J  ,  CH(04),  I  JM 

002960  AT  (24,32),  I  JM 

002970  "to  exit  without  ",  I  JM 

0  02971  AT  (24,48),  FAC(  HEX(8C) ) ,  ME  SINGS,  *.  JM 

0029  80  KE  YS( BIN(0 )&BIN ( 1 6)&BI  N (32  ) )  ,  1  RT 

002990  ON  (BIN(  1 6  )& 8 1 N  ( 32 ) )  GOTO  EXIOM.EXIOM  RT 

003000  RT 

003010  ERJ* “  ":  E$=HEX(8C)  RT 

003020  /*  Check  for  validity  of  entries  */  RT 

003030  RT 

003040  /*  Make  sure  the  files  are  stored  consecutively  */  RT 

003050  FLX=0  RT 

003060  FOR  I»  I  TO  2  RT 

003070  IF  F  IL$(  I  )<>“  "  OR  F  I L  S  ( I  + 1 )  =  "  "  THEN  3090  RT 

003080  FIL3( 1 ) -FIL J( I + 1 ) : FI LJ{ I +1 ) -“  “:FLJH  RT 

00  3090  NEXT  I  RT 

003100  IF  FL  *=  1  THEN  3050  RT 

003110  RT 

003120  /*  Make  sure  the  definitions  are  stored  consecutively  */  RT 

003121  FLX=0  RT 

00312?  FOR  I-  I  TO  2  RT 

003123  IF  DEFSU  )<■>"  "  OR  DEFSU  +  1)*-  ”  THEN  3125  RT 

003124  DEFJ(  I)=DEFJ(I  +  1 )  :OEF}(  1  +  1  )="  ":FLX=1  RT 

003125  NEXT  1  RT 

003126  IF  FL *=  1  THEN  3121  RT 

003130  RT 

003140  IF  POS("  *“=MTWFLS)>0  THEN  3190  RT 

003150  ERJ*“  Mandatory  technical  word  flag  value  is  illegal."  RT 

003160  E  HE  X(94 )  RT 

003170  GOTO  AOK  RT 

003180  RT 

003190  IF  0EFS(1)<>“  "  THEN  UPDATE  RT 

003200  ERJ  -  "Please  enter  your  definition  starting  on  line  1."  RT 

00  3210  El  -  HEX  (9  4)  RT 

003220  GOTO  AOK  RT 

003230  RT 

003240  /*  EXIOM  is  used  to  abnormally  exit  the  insert  mode  and  */  RT 
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003250 
003260 
003270 
003280 
003290 
003300 
003310 
003320 
003330 
003340 
0Q3350 
003360 
003370 
003380 
00339  0 
003400 
003410 
003420 
003430 
003440 
003450 
003460 
003470 
003480 
00349  0 
003500 
003510 
003520 
003530 
003540 
003550 
003560 
003570 
003580 
00359  0 
003600 
003610 
003620 
003  621 
003622 
003  6  30 
003640 
003650 


/*  NOCHAN  is  used  to  abnormally  exit  the  modify  mode  */ 

EX10M:  READ  4  1 ,  H0LD,KEY=W0RD? ,  IOBUFF $ 

IF  NF  = I  THEN  NOCHAN 
DELETE  *1 

ERJ=  “  "&W0RDJ&"  was  not  inserted." 

E  J*  HE X ( 84  ) 

GOTO  CWENU 

NOCHAN:  PROTECT?  =  "  “ 

JPACK  (F=F2J)  IOBUFF?  FROM  PROTECT? 

REWRITE  4  1, 108UFF?,  DATA  GOTO  I0ERR2 

ERJ*  “  No  changes  were  saved." 

ER  1?="  H  :EJ=HEX{84) 

GOTO  CVMENU 

/*  UPDATE  removes  the  protection  on  the  record  and  writes  out  */ 

/*  the  final  data  as  input.  */ 

UPDATE:  READ  #1,  HOLD,  KEYWORD},  IOBUFF? 

PROTECT?  *  "  ":PX*0 

JPACK  (F=F1?)  IOBUFF?  FROM  WORDJ,FIL?( 1 ) ,FILJ(2) ,F IL?(3 ) , ! 

'DEF  J(1),DEFJ  (2),  D£FJ{3),MTWFLJ,  PROTECT? 

REWRITE  41 , IOBUFF J, DATA  GOTO  I0ERR2 
ER1 ?=  "  " 

IF  NF=0  THEN  RITE  /*  NF=0  indicates  insert  mode  */ 

IF  0F=  I  THEN  EXOEL  /*  OF  =  I  indicates  delete  mode  */ 

/*  otherwise  in  modify  mode  */ 

ERJ* . &WORDJ&"  '  modifications  updated  -  Please  continue." 

E J=HEX(8C ) 

WORD?*"  " 

GOTO  CVMENU 

RITE: 

ERJ=  "  '"&WORDJ&"'  inserted  -  Please  continue." 

E  J=  HEX(RC) 

WORD?*"  " 

GOTO  CVMENII 


EXDEL:  0F=0 

ERJ  *"  Deletion  cancelled." 

X  J=HEX  (81 ) 

PASSWRDJ=HEX  (000 102030E 1 0  111  2 1 3  IE20 ) 

GOTO  CVMENU 

EXIT:  CLOSE  #1 


197 
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Print  Abbreviation/Acronym  Glossary  (CRESEBCP) 

CRES@BCP  in  library  CRES0SRC  is  the  BASIC  language  program  to  print  the 
Abbreviation/Acronym  Glossary.  The  object  language  version  is  CRESOBCP  in 
1 i brary  CRES0SAV . 

This  program  first  allows  the  user  to  specify  the  name  of  tne 
Abbreviation/Acronym  Glossary  to  be  printed.  Then  the  program  enables  tne 
user  to  print  out  either  the  list  of  abbreviations,  the  list  of  acronyms,  or 
the  combined  list.  The  glossary  can  be  printed  out  in  its  entirety  or  some 
specified  range  can  be  printed.  This  printout  can  be  displayed  at  the 
terminal  or  sent  to  the  printer.  An  optional  subtitle  of  up  to  two  lines  can 
be  included  for  the  printout,  and  the  number  of  lines  per  page  may  be 
specified  as  some  value  less  than  the  uefault  value  of  5U. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
flowchart. 
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000010  /*  CRES  A8BREVIATI0N/ACR0NW  GLOSSARY  PRINT  PROGRAM  */  RT 

0000  2  0  /*  */  RT 

000030  /*  AUTHOR:  Rose  Tank  */  JM 

000040  /*  Date:  March  12,  1984  */  RT 

000050  /*  */  R1 

000060  RT 

000070  /*  Abstract:  This  program  is  used  to  print  or  display  all  or  */  JM 

000080  /*  part  of  the  Abbrev  i  at  i  on/Acronym  List.  */  JM 

000130  RT 

000140  DIM  COOE$ I  ,MSGJ53,CMSGJ255,MSG2J40,RLIB$8  RT 

000150  DIM  I0BUEF S190, SL IB J8,0PT$19  RT 

000160  OIM  F  ILES08 ,  L  18 S08 ,  SV0LJ6  RT 

000170  OIM  IV0L$06,HEA0ERS51  RT 

000180  DIM  SJ8TITI$20,Suerir?$20  RT 

000190  DIM  ENTERS  Ob,RVOL}6  RT 

000200  DIM  ERS  58  RT 

000210  DIM  TOPS  08  RT 

000220  DIM  RF15S  04  RT 

000230  DIM  PF16$  04  RT 

000240  DIM  X$  01  RT 

000250  DIM  AS ( 3 )  '  01  RT 

000260  DIM  STARTS  16  RT 

000270  DIM  ENOS  16  RT 

000280  RT 

000290  ENTER $=  "ENTER"  RT 

000300  PFI5S  ="PH6"  RT 

000310  PE  I 6S=  "PF 16"  RT 

0  00320  WELCOMEJ="Welcome  to  the  "  RT 

000330  HEADERS  ="CRES  ABBREV IAT 10N/ACR0NW  PRINT  SUBSYSTEM"  RT 

000340  FILES""ABBRELST"  RT 

M03S0  CALL  "EXTRACT"  ADDR(  "  I L " , L  IBS  , "  I V" ,  I  VOLS ,  "SL " ,  SL I BS ,  "SV" ,  SVOLS .  1 
000360  "RL",RLIBS,"RV",RVOLj)  RT 

000370  SELECT  *  1 , " AB6RE V" , VARC ,  INDEXED , RE CS I ZE  =  190 ,KE YPOS=  1  ,  KEYLEN=20,  RT 

000380  10ERR  GOTO  IOERRI  RT 

000390  •  RT 

000400  SELECT  02,  "PRTF  HE  ".PRINTER,  RECS  IZE=  120,  I0ERR  GOTO  I0ERR2  RT 

000410  RT 

00  04  2  0  OPEN  NOGETPARM  #1, SHARED,  F I  LE=  FILES,  LIBRARY  =  UBS,  I  RT 

000430  VOLUME  =  I  VOLS  RT 

00  04  40  RT 

0TXI450  /*  This  section  of  code  generates  the  first  screen,  which  asks  */  JM 

(K10460  /*  for  the  particular  word  interval  and  its  corresponding  */  RT 

000470  /*  prmt  operation.  The  user  is  given  the  option  of  returning  */  RT 

000480  /*  to  the  Glossary  Maintenance  Menu,  if  desired.  *  /  JM 

000510  RT 

000520  ES  :8EX  (8C  )  RT 

0006  30  XS  ="X"  RT 

000540  LPT' %  =50  RT 

000660  ENTERS  =  "ENTER"  RT 

0006  60  PD6*  =  "PF  1  6"  RT 

0TXTS70  PRINT  ..CRN :  R1 

0006  HO  MARIS  =  "r  1RST "  RT 

00UCIH)  ENT'S  "LAST"  RT 

000600  TOPS  "TERMINAL"  RT 

000  6 i 0  AST  :  .Mini  I  I  is,  Sl:Blll2S  ="  "  RT 

0006  ’u  RKTljiRFFN:  rt 

000630  ACCEPT  ;  RT 


i'O  I 
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000640  AT  (01,03), 

000650  "CRES:  Abbreviation/Acronym  Print  Subsystem 
000660  at  ion  Screen)", 

00067  0  AT  (02,03), 

000680  "======  =  =  ===  =============================== 


(List  Specific 


000690  ===========•=", 

000700  AT(04,10),  FAC(  HE  X(8C) ) ,  WELCOME?,  AT  (04 ,25) ,  FAC  (HEX  (85) )  .HEADERS, 
000710  AT  (06,03), 

000720  "  Please  place  an", 

000730  AT  (06,21),  FAC(HEX(85) ) ,  X?  ,  CH(Oi), 

000740  AT  (06,23), 

000750  "next  to  the  appropriate  box  to  specify  which  list  you", 

000760  AT  (07  ,03), 

0007  7  0  "  want  to  print.", 

000780  AT  (08,34), 

000790  "Abbreviations", 

000800  AT  (08,50),  FAC(H£X(8) ) ),  A$(!)  ,  CH(01), 

000810  AT  (09,34), 

000820  "Acronyms", 

000830  AT  (09,50),  FAC(HEX(81 ))  .  AJ(2)  ,  CH(01). 

000840  AT  (fO, 34), 


000650  "Both", 


0008  60 

AT  (10,50),  F  AC(  HEX  (8 1 ) ) , 

A?(  3) 

.  CH(01), 

00087  0 
000880 

AT  (12,13),  FAC(E3), 

AT  (14,03), 

ER? 

.  CH(58), 

000  890 
000900 
000910 

Please  supply  the  following  information  for  the 
.AT  (16,25), 

“Subtitle  (optional)". 

print  system:" 

0009  20 

AT  (16,54),  F  AC  ( HE  X  ( 8 1  ) ) , 

SUBTIT1? 

.  CH(20) , 

000930 
00  0940 
0009  5  0 

AT  (17,54),  FAC  (HE  X(8 1  ) )  , 

AT  (18,25), 

"Starting  abbrev/acronym" , 

SUBTIT2? 

.  CH( 20) , 

000960 
00097  0 
000980 

AT  (18,54),  FAC  (  HE  X  ( 8 1  ) ) , 

AT  (19,25), 

"Ending  abbrev/acronym", 

AT  (19,54),  FAC ( HE X ( 8 1 ) )  , 

AT  (20,25), 

"Lines  per  page", 

START? 

.  CH( 15), 

0009  90 
001000 
ooior 

END? 

.  CH( 15) , 

00102 

001030 

001040 

AT  (20,54), 

AT  (21,25), 

"Print  at  (TERMINAL/PRINTER)", 

L  PP  % 

.  PIC(##), 

00)050 

001060 

001070 

AT  (21,54),  FA C ( HE X ( 8 1 ) ) , 

AT  (23,30)  , 

"Press" , 

TOP? 

.  CH(08) , 

001080 
00l0°0 
001100 
ooi  no 
001 120 

AT  (23,36),  FAC  (HEX  (85)  ) , 

AT  (23,42), 

"to  continue  ", 

AT  (24,15), 

"Press", 

ENTER? 

.  CH ( 05 ) , 

001130 

001140 

AT  (24,21),  FAC(  HE  X(84 ) ) , 

AT  (24,26), 

PF16? 

.  CH ( 04 )  , 

001150  "to  return  to  the  Glossary  Maintenance  Menu  ", 

001 160  KEVS(BIN(  I  6)S8I  N(32  )&8 1  N(0) ) , 

001170  ON  ( B I N ( 1 6 )& BI N ( 32 )  )  GOTO  EXIT, EXIT 
001  180 

001190  ER?  =  "  "  :E?=HE  X(8C) :  WELCOMES .HEADER?-"  " 

001200  IF  A? ( 1 )  = "  "  AND  A?(1)  =  A$(2)  AND  A?(3)  =  "X"  THEN  1260 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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001210 
001220 
001230 
00)240 
001250 
001260 
001270 
001280 
001290 
001300 
001310 
001320 
001330 
001340 
001350 
001360 
001370 
001380 
001390 
001400 
0014)0 
001420 
001430 
001440 
001450 
001460 
001470 
001480 
001490 
001500 
001510 
001520 
001530 
001540 
001550 
001560 
001570 
001580 
001590 
001600 
001610 
001620 
001630 
001640 
001650 
001660 
001670 
001680 
001690 
001700 
0017  10 
001720 
001730 
001740 
001750 
001760 
0017  7  0 


IF  A$(2)="  "  AND  AJ (2)=AJ(3)  AND  AJ ( 1  )  =  "X"  THEN  1260 
IF  A$(3)*“  "  AND  AJ(1)«AJ(3)  AND  A$(?)="X"  THEN  1260 
ER$=  “  Please  mark  only  one  category  with  an  'X'" 
E$=HEX(94) 

GOTO  PRTSCREEN 

IF  STR(  TOPS,  1,1)  =  "P“  T1£N  NE  XT  1  1 
IF  STR(TOPJ,  1,1)0  "T"  THEN  TERMPR 
NEXT]  1:  IF  LPP*<  51  TF£N  NEXT) 3 

ERJ="  'Lines  per  page1  can  be  at  most  50." 

E  $=HEX (84 ) 

GOTO  PRTSCREEN 
I0ERR1:  PRINT  PAGE 

PRINT  BELL.  HEX  (94 ) ;  “ERROR  in  ABBREV/ACRON  W  list." 
FOR  1  =  1  TO  500  000  :NE XT  I 
CLOSE  #1 
GOTO  PRTSCREEN 
I0ERR2 :  PRINT  PAGE 

PRINT  BELL.  HEX{94);  "ERROR  in  print  file." 

FOR  1  =  1  TO  500000  : NEXT  1 
CLOSE  #2 
GOtO  PRTSCREEN 
TERMPR:  E$=HEX(94) 

ER$="'Print  at  ‘  has  only  legal  values  TERMINAL  or  PRINTER." 
GOTO  PRTSCREEN 


REX:  ERS="  'Starting  point'  comes  after  'Ending  point’. 

E $=HE X (94 ) :GOTO  PRTSCREEN 


NEXT  1 3 :  IF  START$  =  "F IRST"  OR  ENOJ=”LAST"  THEN  FORD 
IF  STARTJXENUJ  THEN  REX 


/*  Now  it's  time  to  generate  our  print  file  name  */ 

FORD:  OAT J=  DATE 

0*=  STR(UATJ,3,2)&"/"&STR{  DAT $,5,2)!»"/"&STR(DAT$,),2) 
T}=  STR(TIME,1,2)&":"&STR(TIME,3,2) 

DISPLAY 

AT  (01,03). 

"CRES:  Abbreviation/Acronym  Glossary  Print  Subsystem", 

AT  (01,61), 

"(Generation  Screen)", 

AT  (02,03), 


AT  { 12*23)  , 

"Output  file  now  being  generated'." 

PF ILE  $  =  "ABBREV4# " 

U=0 

NEXT  14:  CONVERT  I  X  TO  STR ( PF  ILEJ.7  ,2)  ,PIC(00  ) 

U=IX+1 

CALL  "LIMITS"  (PF ILE J, SL IBJ, SVOLJ ,COOE$,MSG$ ) 

IF  COOEJ=" Y"  THEN  NEXT14 

OPEN  NOGETPARM  *  2, OUTPUT, FILE=PF  ILE}  ,  L  IBRARY=SL  IBS, 
VOLUME =S VOL J ,SPACE=8000 
GOSUB  TTL  PGE 
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001780 

IF  START*  <>  "FIRST"  THEN  1800 

RT 

001790 

START*1  “  BB“ 

RT 

001800 

IF  END*  =  “LAST"  THEN  END*  *  ALL ( HEX ( FF ) ) 

RT 

001810 

PAGES  =  1 

RT 

00 1 820 

RECSX  *  1 

RT 

001830 

READ  41,  KEY>=START*,  lOBUFF*  ,E0D  GOTO  HOME 

JM 

00 1 840 

GOSUB  HEADER 

RT 

ootaso 

IF  STR  ( IOBUFF*,  ,20)>ENQJ  THEN  HOME 

RT 

001860 

KNOT 

RT 

001870 

IF  A*{  1 )  = 11 X "  AND  STR ( IOBUFF J ,2 1  , 1  )  =  *‘B"  THEN  1910 

RT 

001860 

I  F  A* (  2 )  -  “X"  AND  STR(  IOBUFF*, 21  ,1  )="C“  THEN  1910 

RT 

001890 

IF  AJ(3)=“X"  THEN  1910 

RT 

001900 

GOTO  AGAN 

RT 

0019  10 

WRITE  42,  USI  NS  IMG6,CJ,STR(  IOBUFF*,  1,20), 

I  RT 

001920 

STR  (IOBUFF *,21  ,1)  ,STR{  IOBUFF *,22,55) 

RT 

001930 

RECSX=RECSX+1 

RT 

001940 

IF  STR(  IOBUFF*, 77, 55  )="  “  THEN  1970 

RT 

001950 

WRITE  42,  USING  I MG5 , C* ,  STR ( I OBUF F * , 7 7 , 55 ) 

RT 

001960 

RECSS=RECS  S*-l 

RT 

00197  0 

IF  STR  (IOBUFF*,  132, 55)=“  “  THEN  2000 

RT 

001980 

WRITE  42,  USING  IMG5,CJ,STR(  I08UFF*.  132,55) 

RT 

001990 

RECSX=RECSX+1 

RT 

002  000 

IF  RECSSXLPPX  THEN  RECSS=I 

Rl 

002010 

IF  RECSX=  1  THEN  PAGEX=PAGEX+1 

RT 

002020 

IF  RECSS  -  1  THEN  GOSUB  HEADER 

RT 

002030 

AGAN 

:  READ  4  1,  IOBUFFJ.EOD  GOTO  HOME 

RT 

002040 

IF  STR(  IOBUFF*, ,20)>END*  THEN  HOME 

RT 

002050 

GOTO  KNOT 

RT 

002060 

HOME 

WRITE  42,  USING  Til,  C* 

RT 

002070 

WRITE  42,  USING  TIT,  C* 

RT 

002080 

WRITE  42,  USING  IMG8,  C* 

RT 

002090 

CL0SE4  2 

RT 

002100 

IF  STR ( TOP* ,  1 ,  1  )  ="P“  THEN  MESS 

RT 

0021  10 

CLOSE  WS 

RT 

002120 

MSG2*  =  "CANCEL  Processing" 

RT 

002130 

MSK  J=HE  X  ( 00 ) 

RT 

002140 

CMSGJ  =  "  " 

RT 

002150 

CALL  “LINK"  ADDR( "D1SPF ILE ", "P",RLIB* ,RV0L*,3S,PF ILE*, 

I  RT 

002 1 60 

SL  IB *,  SVOI  * ,  "C" ,M SG2*,  27  S,  "H“,MSK*,  CMSG* , 255 S, CS,R S) 

RT 

002170 

ER*  =  "  "  :E$=HEX(RC ) 

RT 

002180 

IF  CSOO  OR  RX<>0 

I  RT 

002190 

THEN  ER*  =  STR  (CMSG*  ,141) 

RT 

002200 

GOTO  PRINTSCRN 

RT 

002210 

RT 

002220 

MESS 

:  ER*="Fi  le  "&  P  F I L  E  "  in  Library  "&  SLIB*  &"  on  "&  SVOL*  i 

:  rt 

002230 

"  generated. " : E  J  HE X (84  ) 

RT 

002240 

GOTO  PRINTSCRN 

RT 

002250 

RT 

002260 

Til 

PGE: 

RT 

002270 

C*=HEX(800I ) 

RT 

002260 

WRITE  42,  USINb  TIT,  CJ 

Rl 

002290 

C*  =  HEX (00 1 5 ) 

RT 

002300 

WRITE  42,  USING  TIT,  C* 

RT 

002310 

C*  =  HE  X ( 000 1  ) 

RT 

002320 

WRI TE  42,  USING  Till  ,  C* 

RT 

0023  30 

WRITE  42,  USING  TIT2,  C* 

RT 

002340 

WRITE  42,  USING  TITO,  C*,D*,T* 

RT 

204 
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002350 
002360 
00237  0 
00238  0 
002390 
002400 
002410 
002420 
002430 
002440 
002450 
002460 
002470 
002480 
0  02481 
00  24  8  6 
002488 
00  24  90 
00  2500 
002510 
002520 
002530 
002540 
0C2550 
002560 
00257  0 
002580 
002590 
002600 
002610 
002620 
002630 
002640 
002650 
002660 
002670 
00  2  680 
002690 
0027  00 
0  027  1  0 
002720 
0027  30 
0027  40 
0027  50 
0027  60 
002770 
0  027  80 
002790 
002800 
002810 
002820 
002830 
002840 
002850 
002860 
002870 
002880 


WRITE  #2.  USING  TIT3,  CJ 
WRITE  42,  USING  TIT2,  CJ 
WRITE  #2,  USING  TIT1,  CJ 
WRITE  #2,  USING  TIT2,  CJ 

IF  SUBTIT1 J  =  M  "  THEN  GER 

WRITE  *2,  USING  TIT4,  CJ,  SUBTIT  I J 
IF  SUBTIT2JO"  *  THEN  WRIT 

TIT10,  CJ,  SUBTIT2J 

WRITE  *2,  USING  TIT2,  CJ 

GERRY: 

WRITE  #2,  USING  TIT8,  CJ,  STARTJ 

WRITE  *2,  USING  TIT2,  CJ 

WRITE  #2,  USING  TIT9,  CJ,  END  J 

WRITE  * 2 ,  USING  TIT2,  CJ 

IF  AJ( 1 )="X*  THEN  OPTJ="PRINT  ABBREVIATIONS" 

IF  AJ(2)-“X"  THEN  0PTJ«"PRINT  ACRONYMS" 

IF  A J ( 3 ) ="X“  THEN  OPTJ="PRINT  BOTH" 

WRITE  *2,  USING  TIT5,  CJ,  OPTJ 

WRITE  #2,  USING  T1T2,  CJ 

WRITE  *2,  USING  TIT1,  CJ 

RETllRN 

HEADER: 

IT  PAGFX=I  THEN  FIRST 
CJ  =  HEX(0001 ) 

WRITE  *2,  USING  TIT,  CJ 
FIRST:  CJ  =  H£X(600I  ) 

WRITE  42,  USING  TIT,  CJ 
CJ  =  HE  X  ( 000 1  ) 

IF  SUBTIT1 J  =  “ 

THEN  WRITE  *2,  USING  IMG.CJ.DJ.TJ.PAGE X 
ELSE  GOTO  FOOT 
GOTO  ALRITE 

FOUT:  WRITE  4 2 ,  USING  IMG1  ,C J, SUBT I T1 J ,D J, T J, PAGE X 
IF  SUBTIT2JO  ” 

THEN  WRITE  #2,  USING  IMG7  ,CJ,  SUBTI  T2J 
ALRITE  :  WR I TE  #2,  USING  IMG2,  CJ,L IBJ , I  VOL J 
WRITE  42,  USING  IMG3,  CJ 
WRITE  42,  USING  IMG4,  CJ 
WRITE  42,  USING  IMG5,  CJ 
WRITE  42,  USING  IMG3,  CJ 
RETURN 


11  THEN  GERRY 
THEN  WRITE  42,  USING 


T I  TO :  X44 

***** 

TIT:  X44 
T I T 1 :  X44 

TI  T2 :  X44 

TIT3:  X44 
***** 

T I  T4  :  XM 
****** 
TIT5:  X44 
***** 
TIT8:X44 


******** 


******  ABBREVIATION/ACRONYM  GLOSSARY! 
TITLE  OF  LIST  :  ************** ; 
OPTION  SELECTED  :  **************'. 


STARTING  POINT  :  **************'. 
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00289  0  ******  1  RT 

002900  T1  T9 :  %**  I  ENDING  POINT  :  **************'.  JM 

002910  ******  I  RT 

0029  2  0  TIT10:  X**  !  ttt**********'.  RT 

0029  30  *******  \  RT 

002940  IMG:  V*  ********  *****  \  RT 

002950  PAGE  *****  RT 

002960  IMG1 :  XM  TITLE  OF  LIST  :  ********************  ********  1  RT 

0029  7  0  *****  PAGE  *****  RT 

002980  IMG7 :  X**  ********************  RT 

002990  IMG2:  V*  Input  File  is  AB8RELST  in  Library  ********  on  Volume  ***'.  RT 
003000  ***  RT 

003010  IMG3:  %##*==“====*=*=  ===*«===**================*===-====*======  =  =  !  RT 

003020  .»«**======  ==============  RT 

003030  IMG4:  %**  Abbrev/ Acronym  Type  Definition  RT 

003040  IMG6:  V*  ********************  *  ****************************[  RT 

003050  ***************************  RT 

003060  IMG5: V  *  ****************************[  rt 

003070  ***************************  RT 

003080  IMG8:  V*  III  END  OF  LISTING  RT 

003090  RT 

003100  EXIT:  CLOSE  7*1  RT 


i£06 


MM 


l*E 


ical  Kei_ - 


Print  Technical  Glossary  (CRES6L0P) 

CRESGLOP  in  library  CRESl^SRl  is  the  BASIL  language  program  to  print  the 
Technical  Glossary.  The  object  language  version  is  CREGGLOP  in  library 
CRESGSAV. 

This  program  first  allows  the  user  to  specify  the  name  of  the  Technical 
Glossary  to  be  printed.  Then,  the  program  enaDles  the  user  to  print  out 
either  onTy  the  Mandatory  Technical  Words  that  appear  or  the  entire  Technical 
Glossary.  The  glossary  can  be  printed  out  in  its  entirety  or  some  specified 
range  can  be  printed.  This  printout  can  be  displayed  at  the  terminal  or  sent 
to  the  printer.  An  optional  subtitle  of  up  to  two  lines  can  be  included  for 
the  printout,  and  the  number  of  lines  per  page  may  be  specified  as  some  value 
less  than  the  default  value  of  bO. 

A  complete  program  listing  follows.  Appendix  C  contains  a  sample 
f 1  owe  hart . 


2^1 
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000010  /*  CRES  MANDATORY  TECHNICAL  GLOSSARY  PRINT  SUBSYSTEM  PROGRAM  */ 


000025 

/* 

*/ 

000040 

/* 

AUTHORS:  Rose  Tank  and  John  Mears 

*/ 

000055 

/* 

Date:  Octooer  12,  1983 

*/ 

000070 

000085 

/* 

*/ 

000 100 

/* 

This  suDsystem  is  not  integrated  with  any  other  part  of 

the 

*/ 

000115 

/* 

CRES  suosystem.  The  glossaries  are  used  exclusively  for 

the 

*/ 

000130 

/* 

user's  reference.  The  following  code  allows  any  portion 

of 

*/ 

000145 

/* 

the  mandatory 

technical  glossary  to  De  printed  for  easy 

*/ 

000160 

/* 

viewing. 

*/ 

000175 

/* 

*/ 

000190 

/* 

Record  format 

tor  the  mandatory  technical  glossary: 

*/ 

000205 

/* 

columns 

contents 

*/ 

000220 

/* 

1-20 

word 

*/ 

000235 

/* 

21-28 

technical  word  list  in  which  the  word 

*/ 

000250 

/* 

is  presently  residing  (optional) 

*/ 

000265 

/* 

29-83 

definition  line  1 

*/ 

000280 

/* 

84-138 

definition  line  2 

*/ 

000295 

/* 

139<-193 

definition  line  3 

*/ 

000310 

/* 

194-19o 

protection  ID 

*/ 

000325 

/* 

197-200 

filler 

*/ 

000340 

/* 

*/ 

000355 

/* 

NOTE:  Each  of 

the  definition  lines  consist  of  a  55  char. 

*/ 

000370 

/* 

buffer. 

*/ 

000385 

000400 

000415 

000430  DIM  CODS$l,IOBUFP$2l5,FILE$8,LIB$8,lVOL$6,ER$58,'TOP$8,START$20 
000445  DIM  END$ 20 , HEADERS40 , SUBTI T1S20 , 5UBT IT2$20 

000460  DIM  ENTERS 5, PF1 5S4 ,  Pr  16S4 ,  X$1 , RLIBf 8 , RVUL$6  RT 

000475  DTM  MSG$5  3,CMSG$255,MSG2$40 ,SLI3$8,SVOL$6,OPT$20 

000400 

000  50  5  ENTERS  =  *  ENTER " :  PF 15$=*  PF1 5  * : PF1 6$  =  *  PF1 6  * 

000520  E$=HEX( 8C) :X$="X"  Ri 

000535  WELCJME$=" Welcome  to  the  * 

000550  HEADERS  ="CRES  GLOSSARY  PRINT  SUBSYSTEM" 

000552  CALL  *  EXTRACT"  ADDR(  "  IL*  ,  LIBS,  “  IV"  ,  IVOLS,  "SL"  ,SlIB$,  "SV"  ,SVOL$,  ! 
000854  *Rl",Rl1B$,"RV",RVUL$) 

000565  FILE$=*GLOSSARY* 

000580 

000595  SELECT  |1, "GLOSSY", VAHC, INDEXED, RECSI4S=215,KEYi\)S=1,KEYLEN=20,  1 

000610  IOERR  GOTO  IOERRl 

000o25 

000640  SELECT  »2,  "PRTFILE"  , PRINTER, RKCSIZE=12U,  IOERR  GOTO  IOERR2 
000655 

000670  OPEN  NOGETPARM  # 1 , SHARED,  FILE=  FILES,  LIBRARY  =  LIBS,  ! 

000685  VOLUME  =■  IVOLS 

000700 


000715  /*  This  screen  aLLows  you  to  choose  the  range  of  words,  the  */ 
00U730  /*  number  ot  lines  per  page,  and  the  destination  of  the  output  */ 
000745  /*  ( terminal/printer) .  */ 
OOU/bO 

000775  PRINTSCRN:  /*  The  following  are  the  defaults*/ 
000790  STARTS  -"FI RST  "  /*  for  the  print  screen  */ 
00U805  ENDS  ="  I A3T" 

000820  LPPfc=50 
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000835 

000850 

000865 

000880 

000895 

000910 

000925 

000940 

000955 

000970 

000985 

001000 

001006 

001015 

001030 

001045 

001060 

001075 

001090 

001105 

001120 

001135 

001150 

001165 

001180 

001195 

001210 

001225 

001240 

001255 

001270 

001285 

001300 

001315 

001330 

001345 

001360 

001375 

001390 

001405 

001420 

001435 

001450 

001465 

001480 

001495 

001510 

001525 

001540 

001555 

001570 

001585 

001630 

001645 

001660 

001675 

001690 


TOP$=  *  TERM  I NAL  * 

SUBTITIS,  SUBTIT2S  =•  * 

PRTSCREBN: 

ACCEPT 

AT  (01,03) , 

"CRES:  Glossary  Print  Suosystem", 
AT  (01,66), 

"(Print  Screen)*, 

AT  (02,03), 


STARTS 


AT( 04,15),  FAC(HEX(8C) ) ,  WELCOMES, AT{04, 30)  ,FAC(HEX(  85) ), HEADERS, 
AT  (06,02), 

"  Please  place  an", 

AT  (06,20),  FAC( HEX{ 85) ) ,  X$  ,  CH(01), 

AT  (06,22), 

"in  the  oox  Delow,  if  you  want  to  print  only  the  mandatory", 

AT  (07,02), 

"  technical  words  that  appear  in  the  glossary.", 

AT  (09,25), 

"Mandatory  Technical  Word", 

AT  (09,52),  FAC( HEX( 81 ) ) ,  AS  ,  CH(01), 

AT  (11,13),  FAC(ES),  ER$  ,  CH[58), 

AT  (13,02), 

"  Please  supply  t lie  following  information  for  the  print  system:" 

, AT  (15,25), 

"Suotitle  (optional)*, 

AT  (15,54),  FAC( HEX( 81 ) ) ,  SUBTITIS  ,  CH(20), 

AT  (16,54),  FAC(  HEX(81) ) ,  SOariT2S  ,  CH(20), 

AT  (18,25), 

"Starting  word  ", 

AT  (18,54),  FAC(  nEX(  81 ) ) ,  STARTS  ,  CH(  15)  , 

AT  (19,25), 

"Ending  word  ", 

AT  (19,54),  FAC(  HEX( 81 )  ) ,  ENDS  ,  CH(15), 

AT  (20,25), 

"Lines  per  page", 

AT  (20,54),  LPP*  ,  PIC(I#), 

AT  (21,25), 

"Print  at  (TERMINAL/PRINTER) " , 

AT  (21,54),  FAC( HEX( 81 ) ) ,  TOPS  ,  CH(08), 

AT  (23,30), 

"Press" , 

AT  (23,36),  FAC'(  HEX(  85)  ) ,  ENTERS  ,  CH(05), 

AT  (23,42), 

"to  continue  ", 

AT  (24,15), 

"Press" , 

AT  (24,21),  PAC( HEX( 84 ) ) ,  PF16S  ,  CH(04), 

AT  (24,26), 

"to  return  to  the  Glossary  Maintenance  Menu  ", 

KEYS( BIN( 0) &3IN( 16) &3IN( 32) ) , 

ON  (BXN( 16)6BIN( 32) )  OOTO  EXIT, EXIT 

ERS="  "  :ES=HEX(  80  : WELCOMES, HEADERS-"  " 


ENTERS 


,  CH( 20) , 
,  CH( 20) , 


,  CH( 15) , 


,  CH  (15), 


,  PIC(I#), 


,  CH( 08) , 


,  CH( 05) , 


,  CH( 04 ) , 


tK. 


210 
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Page 


001706  /*  3e£ore  leaving  this  screen,  be  sure  ail  values  input  are 
001720  /*  legal  entries. 

001722 
001724 
001726 
001727 
001728 
001735 
001750 
001765 
001780 


*/  JM 

V  JM 

IF  POSC  X"=A$ )>0  THEN  1735  RT 

ERt="  Please  only  use  'X'  to  specify  t he  mandatory  words."  PT 

£$=HEX(  94 )  PT 

GOTO  PPTSCREEN  PT 

RT 

IF  5TP(  TOPS,  1,1)  =  “P"  OP  Srp(TOP$,,l)=  "T*  THEN  LINESCK 
E$=HEX( 94) 

EP$=" ' Print  at  ‘  has  only  legal  values  TERMINAL,  or  PPINTEP." 
GOTO  PPTSCREEN 
001795  LINESCK :  IF  LPP4 <  51  THEN  HANGECK 

001810  £R$="  'Lines  per  page'  can  oe  at  most  50." 

001825  E£=HEX( 84 ) 

001840  GOIU  PPTSCREEN 

001855 

001870  PEX:  ER£=“  ‘Starting  word'  comes  after  'Ending  word'." 

001885  E$=HEX( 94) :GOIO  PPTSCREEN 

001900  PANGECK:  IF  START$=* FIRST"  OR  £ND$=*LAST"  THEN  FORD 

001915  PF  START$>ENDS  THEN  PEX 

001930 

001945  /*  Now  it's  tim?  to  generate  our  print  file  name  */ 

001960 

0019  75  FOPJ :  DAT$=  OAl’E 

001990  DS  =  STR(  DATS,  3, 2)  &"/"6<STR(DAT$,  5,  2)  6*/*&STR(  DATS,  1,2) 

002005  T$=  STR(TIME,  1,2)6* :*&STP( TIME,  3, 2) 

002020 

0020  35  /*  The  use  of  this  start  screen  is  just  to  let  the  user  know  the*/ 
002050  /*  output  file  is  being  generated.  */ 

002065  DISPLAY 
002080  AT  (01,03), 

002095  "CRF-S:  Glossary  Print  Subsystem* , 

002110  AT  (01,61), 

002125  "(Generation  Screen)*, 

002140  AT  (02,03), 

002170 

002185  AT  (  12,2  ))  , 

0U2200  "Output  tile  now  oemj  generated!" 

002215 

0022  )0  /*  Create  an  new  output  tile  lor  tlus  run  */ 


JM 

JM 


JM 


pr 


002245 

002260 


PF  I,  ,ES  =  "Giossy##" 

r  4=0 


pr 


0022/5  N  EX  IT  4  :  CGNVEPT  14  1U  S1'P(PFILES ,  /, 2)  ,PIC(  00) 


002290 

002305 

002320 

002335 

002350 

002365 

002425 

002440 

002455 

002470 

002485 

002500 

002515 


14  I  4 «- 1 

CALL  "LIMITS*  (  PPIl.ES  ,Sl.I8$,SVOL$ ,  CODES  ,MSG$ ) 

IF  OODES=“f"  THEN  NEXT14 

OPEN  NuGETPARM  #2, OUTPUT, FlLE=PFILES,LIBRARy=SLlB$,  ! 

VOLUME=SVOL$,SPACE=8000 

GOSU3  Ti'L_PGE 

IF  STARTS  O  "FIRST*  THEN  2500 

.STApr$="  N"  /*  Recall  the  first  value  in  */ 

/*  tile  is  '  Mandatory  Tecim*/ 
/*  cal  Glossary1  */ 

IF  ENDS  =  "tASr  THEN  ENDS  =  ALL(HEX(FF)) 

PAGE4  =0:  PECS 4  =  1 


PT 
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002530 
002545 
002560 
002575 
002576 
002577 
002579 
002590 
002605 
002620 
002635 
002650 
002665 
002680 
002695 
002710 
002725 
002740 
002755 
002770 
002785 
002800 
002815 
002830 
002845 
002860 
002875 
0028% 
002905 
002920 
002935 
002950 
002965 
002980 
002995 
003010 
003025 
003040 
003055 
0030  70 
003085 
003100 
0031 15 
003130 
003145 
003160 
003175 
003190 
003205 
003220 
003235 
003250 
003265 
003280 
003295 
003310 
003325 


KNOT: 


READ  |1,  KE1f>=STARTS,IOaUFFS,BOD  QOIV)  HOME 
Q3SUB  HEADER 

IP  STR(  IOBUFFS,,20)>END$  THEN  HOME 


JM 


THEN  2590 


RT 

RT 

RT 


AO  AN 


HOME: 


IF  A$=*  *  THEN  2590 
IP  AS=’X"  AND  STR( IOBUPFS, 210,1) 

GOIO  AGAN 

WRITE  #2,  USING  IM36,CS,STR( IOBUFFS,1,20) , 

ST R(  I08UFFS, 210,1)  ,Si'R(  I08UFFS, 21 ,8)  ,STR(  IOBUFPS, 45, 55) 
RECS%=RECS%tl 

/*  Only  print  the  definition  lines  that  ate  nonblank  */ 

IF  STR{  IOBUFFS, 29,8)=*  *  AND  STR( IOBUFFS, 100, 55)=“  *  THEN  2710  RT 
WRITE  #2,  USING  IMGS,C$,STR( IOBUFFS, 29, 8) ,  ! 

STR( IOBUFFS, 100, 55) 

RECS%=RECS*tl 

IF  STR(  IOBUFFS, 37,8)="  "  AND  STR( IOBUFPS, 155, 55) =*  *  THEN  2755  RT 
WRITE  |2,  USING  IMG5,C$,STR( lOOUFFS , 37,8) ,  ! 

STR(  IOBUFFi),  155, 55) 

RECS%=RECS%+1 
If*  R£CS%>LPP%  THEN  RECS%=1 
IF  R£CS%  =  1  THEN  QOSU3  HEADER 
■  READ  #1,  IOBUFFi, £UD  GOTO  HOME 

IF  5TR1 IOBUFFS, ,20) > ENDS  THEN  tiOME 
GOTO  KNOT 

WRITE  #2,  USING  TIT,  CS 
WRITE  #2,  USING  TIT,  CS 
WRITE  #2,  USING  IMG8,  CS 
CLOSE#  2 

IF  STR(TOP$,  1,1)  =“P“  THEN  MESS 
CLOSE  WS 

MSG2S  =  “CANCEL  Processing" 

MSKS=HEX(00) 

CMSGS  =  "  *  /*  otherwise  link  to  DISPLAY  */ 

CALL  “LINK"  ADDR(  "DISPFILE","P“,RLIS$,RVOL$,3%,PPir£$, 

SLIBS ,SVUL$ ,  * C"  ,MSG2$ ,  27* ,  “H"  , MSKS , CHSGS ,  255% ,C% , R%  ) 

ERS  =  *  "  :E$=HEX(8C) 

IF  C%O0  OR  R%<>0 
THEN  ERS  =  STR(CMSG$, 141) 

GOTO  PRINTSCRN 


/*  It  tlie  printer  was  */ 
/*  chosen  for  output  */ 
then  notify  user  or*/ 


UM 


/ 

/*  output  file  Id 


‘/ 


MESS:  ER$=*File  “iPPILESi"  in  Liorary 
"  generated. * :E$=HEX( 84) 

GOTO  PRINTSCRN 


‘6  SLI8$  4“  on  "6.  S\K)L$  6 


/*  Print  the  title  page  with  suntittes  supplied,  starting  words,*/  JM 
/*  and  ending  words.  */  jm 
TTL  PGE: 


WRITE 

12,  USING 

TIT, 

HEX(8U0i> 

WRITE 

#2,  USING 

TIT, 

HEX( 0015) 

C$  =  HEX(OOOl) 

WRITE 

12,  USING 

Tin, 

CS 

WRITE 

12,  USING 

TIT2, 

C$ 

WRITE 

12,  USING 

nro. 

cs,d$,t$ 

WRITE 

#2,  USING 

TI T3, 

CS 

WRITE 

12,  USING 

TIT2, 

c$ 

WRITE 

|2,  USING 

TIT1, 

cs 

WRITE 

#2,  USING 

TIT2, 

c$ 

2 1 2 


I 
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003340 
003355 
003370 
003385 
H03400 
003415 
003430 
003445 
003460 
003475 
003476 
003480 
003485 
003490 
003505 
003565 
00353U 
003595 
003610 
003625 
003640 
003655 
00  36  70 
uuioo j 
00  3700 
003/15 
003/30 
003745 
003760 
0037/5 
003790 
003805 
003820 
003835 
003850 
003865 
003880 
003395 
003910 
003925 
003940 
003955 
003970 
003972 
00  3974 
003985 
U04UUU 
004015 
004030 
004045 
004060 
001075 
004090 
004105 
004120 
004135 
1)04150 


rrno. 


if  suarrri$  =  * 

WRITE  |2,  USING  TIT4,  C$,  SUBTITIS 
IF  SU3TIT2$<>* 

C$,  SUBTIT2S 

WRITE  »2,  USING  TIT2,  C$ 


THEN  GERRY 


THEN  WRITE  #2,  USING 


WRITE  *2,  USING  T1T8,  C$,  START'S 
WRITE  |2,  USING  TIT2,  C$ 

WRITE  #2,  USING  TIT9,  C$,  ENDS 

WRITE  #2,  USING  TIT2,  C$ 

IF  A$="X*  THEN  OPTS“*MANl)  TECH  WORDS  ONLY*  ELSE  JPTS=*ALL* 
WRITE  #2,  USING  TITS,  C$,  OPTS 
WRITE  *2,  USING  TIT2,  C$ 

WRITE  12,  USING  TITi,  C$ 

RETURN 

PAGE*=PAGE*t-l 
IF  PAGE%= 1  THEN  FIRST 
WRITE  |2,  USING  TIT,  C$ 

WRTTE  #2,  USING  TIT,  HEX(8001) 

IF  SUBTIT1SO  *  “  THEN  FOOT 
WRITE  #2,  USING  IMG,C$,D$,T$,PAGE% 

GOTO  ALRITE 

WRITE  12,  USING  lMGl,C$,SU8Tiri$,OS,r$,PAGE4 
IF  SUHTIT2S <>”  *  THEN  WRITE  *2,  USING  IMG7,C$,SJBTI  T2S 

: WRITE  #2,  USING  IMG2,  C$,  LIBS,  IVOLS 

WRITE  12,  USING  IMG3,  C$ 

WRITE  *2,  USING  IMG4,  C$ 

WRITE  #2,  USIlsIG  IMG5,  C£ 

WRITE  #2,  USING  IMG3,  CS 

RETURN 


T I  TO :  %  1 1 
MM3 
TIT:  431 
TITl.-if# 


TI T2 :  %  (f  # 

I 

TI T3 :4#  * 

*****  » 

TI  T4 :  %  #  # 

##»###  : 

TITO:*## 

#*#*##  : 

TI TB : %## 

******  : 

n  to  Tii  i 

mm 

nno.-m 

mm* 

rMG:%»*  **#*««#> 


mm*> 


ORES  GLOSS AR  Y 


TITLE  OF  LIST 


STARTING  POINT 


ENDING  POINT 


«m»mmm:  jm 


MMMMMMM!  JM 


«*mmmm:  um 


mmimmmmi:  j n 


immmhmm: 


MI:*#*  ********  ***** 

PAGE  ***** 

1 MG 1:4*#  TITLE  OF  LIST  :  #»»*#**##•**«******«  «*»#«»»# 

*****  PAGE  ***** 

I  MG / : %  #  #  *«#***»*llt*«******* 

r.MG2 :  %#  *  Input  File  is  G I  OSS  ARY  in  Library  ##**(**#  on  Volume  fit; 


/l  j 
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004165  HI 

004180  IMG 3 : %f  |= ============= ==========================================; 

004195  ============================================  RT 

004210  IMG4:%||  Word  Mand  Tech  File  Oerinition  RT 

004225  IMG6: %||  IMMtlf I  Mtllflt  IIIMtlOfl!  RT 

004240  MiMiMMiiiiimiMimimtiMtiiiiiimt  rt 

004255  IMG5:%»»  HliflMI  RT 

004270  RT 

004285  1MG8:%I#  END  OF  LISTING  *. *. 

004300 


004315  IOERR1 :  PRINT  PAGE 

004330  PRINT  BELL,  HEX(94);  'ERROR  in  GLOSSARy  list."  JM 

004345  FOR  1=1  TO  500000  :N£XT  I 

004360  CLOSE  #1 

004375  GOTO  PRTSCREEN 

004390  IOERR2:  PRINT  PAGE 

004405  PRINT  BELL,  HEX(94);  "ERROR  in  print  file.* 

004420  FOR  1=1  TO  500000  : NEXT  I 

004435  CLOSE  #2 

004450  GOTO  PRTSCREEN 

004465  EXIT:  CLOSE  #1 


CRES@ERW  in  library  CRES@SRC  is  the  BASIC  language  program  to  perform  the 
CRES  root  word  expansions  and  merge  the  expanded  forms  into  the  CRES  word 
lists.  The  object  language  version  is  CRES@ERW  in  library  CRESL^SAV. 

In  the  CRES  system,  a  root  word  is  defined  as  the  simplest  form  of  a  word, 

that  form  which  cannot  be  reduced  any  further;  i.e.,  the  singular,  present 

tense  word  for  nouns,  verbs  and  adjectives.  Most  other  parts  of  speech  have 
only  one  form,  which  is  considered  the  root  word.  If  the  root  word  form  of  a 

word  appears  on  one  of  the  CRES  word  lists,  it  is  usually  desirable  to  have  at 

least  the  more  common  expanded  forms  of  that  word  included  as  well.  This 
system  will  expedite  these  expansions.  For  the  more  common  parts  of  speech, 
(nouns,  verbs,  and  noun/verbs),  the  program  automatically  supplies  suggested 
suffixes  to  form  the  plurals  and  past  participles.  The  user  has  the  option  of 
eliminating  any  of  the  automatically  formed  expansions  or  correcting  their 
spellings.  In  addition,  up  to  20  different  forms  of  the  root  word  may  be 
generated  by  the  us^r.  After  all  expansions  have  been  specified,  the  program 
will  present  them  to  the  user,  one  at  a  time,  for  the  part  of  speech  ana  other 
attributes  to  be  entered  for  each. 

When  the  root  word  expansion  is  complete,  the  user  can  display  the 
expansions  on  the  terminal,  print  out  a  hard  copy,  and/or  permanently  merge 
the  expansions  into  one  of  the  CRES  word  lists.  The  program  also  allows  the 
user  to  return  and  modify,  delete  from,  or  add  to  the  expansions  already 
specified.  The  list  of  expansions  is  contained  in  a  work  file,  which  may  be 
retained  on  disk  or  deleted  if  no  longer  required. 

Figure  3  presents  a  flowchart  of  the  root  word  expansion  program.  A 
complete  listing  follows. 
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0000 10  /»  */  RT 

000015  /*  PROGRAM  CRES  ROOT  WORD  EXPANSION  SUBSYSTEM  */  RT 

000020  /*  AUTHOR  ROSE  TANK  »/  RT 

000025  /*  DATE  PEBRUARY  9,  1984  */  RT 

000030  /*  */  RT 

000035  RT 

000040  DIM  PILEt8,LI3t8,VOLt6,Dr'ILt8,DLIBt8,DVOLt6,PPILEt8,BUPFt  RT 

000045  DIM  0PBN%(3),R0C«WD$20,PRT0SPC$l,EXPANDS(20)20,>ORD$20,PPART$l  RT 

00005U  DIM  N£Gtl,'IU3Efl,ROL>Tti,MTVtl,IOaUPFt40,At(14)iO,SLl3t8,SVOLf6  RT 

000055  DIM  HEADER$34, ITLE1$6,  ITLS2$11,ENTERS5,PP1$3,PP2S3,PPLS$4,PF16$4  JM 

000060  DIM  ITLEJti8, ITLE4tl4,RlO£XPtl0,MANDf24, ITLE5tl4,  ITLEbtlO  JM 

000065  DIM  P$(13)  3,EXi>£9/Pr'XEYt6,Pr’£2,OPERAiTONf27,SOali20,SUB2f20,aODEtl  RT 

000070  DIM  RR$71, B$1,E$(  20)  l,ERl$65,El$i,P$i,Ltl,  Vtl,CMSG$255,MSK$2  RT 

000071  DIM  RLIB$6,RVOL$6,PASSWORD$9  JM 

000075  RT 

000080  P It-HHXi  A0 1 4A001A00 1A00 1AO0 10001A00 1A001000100030009)  R T 

000085  HEADERt  =‘CRES  ROOT  vJUilD  EXPANSION  SUBSYSTEM*  RT 

000090  PILES  ="CMNWDLST"  RT 

000091  CALL  'EXTRACT*  ADOR(  *  IL*  ,  LIBS,  "  IV"  ,  VOLt,  *SL'  ,SLIBt,  *SV“  ,SVOLt ,  ! 

U00093  “RL"  ,RLI3t,  “RV" ,  RVOLt) 

000105  ENTERt  =' ENTER"  RT 

000110  PP16S  =*PP  16"  RT 

0(30115  ITLElt  ="CDMMON"  JM 

000120  iTr,E2t  ="less  common"  jm 

000125  ENTE.lt  =" ENTER"  RT 

000130  PPit  =’PPl"  RT 

000135  PP2t  ='PP2"  RT 

000140  PFISt  ="PP15"  RT 

000145  1TLP. 5$  ="  PART  OP  SPEECH"  JM 

000150  ITLE6$  ^DEFINITION"  JM 

000155  Pti l)=*i J) " :Pt( 2) =*(  j) * :Ptl 3)=" ( A)* :P$(4) =*(a) " :P$(5)='(3) *  RT 

000 160  P$i 6)="i C) * :Pti 7)="( I)* :P$( 8) =" (N) " : P$( 9)=* (n) " : P$( 10) ="(  P)'  RT 

000165  Pt(li)="(0)':Pt(l2)=*(V)":P£(13)=*(d)*  RT 

000170  EXP$-'  expans  ion*  ,  RT 

UU0175  PFXEYt  ="PF-Kay"  RT 

000180  PFt  ="PP"  RT 

000185  OPERATIONS  ="  OPERATION  ’  RT 

000190  Alt  ="1*  :  A2t  ="  2* :  A3t  =*3":  Ai5$=>"!5":  A16t»*16*  RT 

000195  At! 1)=  “adjective"  RT 

000200  Ati  2)  -  *vern*  RT 

000205  At(3)=  "conjunct* n*  RT 

000210  Ati4)=  'ad j/ verb'  RT 

000215  At(S)=  "noun"  RT 

000220  Ati 6) *  "pronoun"  RT 

000225  Ati 7>=  “interject"  RT 

000230  Ati  8)  -  “noun/voro"  RT 

000235  Ati 9)  =  'adverb'  RT 

000240  Ati 10)="preposit"  RT 

000245  Ati il)='articlo"  RT 

000250  Ati I2)="adv/verb"  RT 

000255  Ati 13)=" noun/ad j"  RT 

000260  RT 

000265  SELECT  *1,  "v*JRJLIST",  VARC,  INDEXED,  RKCSUE=40,  XEYPOS=i,  RT 

000270  XEYLEM-20,  IOERR  GOTO  IOERR1  RT 

U00275  SELECT  #2,  "WDEXi’AND" ,  VARC,  INDEXED,  RECSIZE=40,  KEYPOS=l,  I  RT 

000280  KEYU-1N-20,  IOERR  GOTO  IOERR2  RT 

000235  SELECT  #3,  "PRINTP1L",  PRINTER,  RECSUE=80,  IOERR  GOTO  IOERR3  RT 


»<*  7.  r.  '‘■JimWs’-’.- 
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000290  RT 
000295  SCREEN!:  ER£=»"  ":Ft,Lfi,V$  »HEX(8i):  E$=H£X(8C)  RT 
000300  FILrtNU:  RT 
000305  ACCEPT  !  RT 
000310  AT  (01,03),  1  RT 
000315  "CRES:  Root  Word  Expansion  Suosystein  (File  Sele!  RT 
000320  ction  Screen)*,  !  Rf 
000325  AT  (02,03),  I  RT 
000330  "================================================a«””==”*!“1”'.  RT 

000335  =============",  !  RT 

000340  AT  (04,20),  I  RT 
000345  'Welcome  to*,  !  RT 
000350  AT  (04,31),  FACtHEX!  85) ) ,  HEADERS,  CH(34),  !  RT 
000355  AT  (06,03),  !  RT 
000360  *  This  system  allows  the  expansion  of  root  words  to  De  entered!  RT 
000365  into  an",  !  RT 
000370  AT  (07,03),  !  RT 
000375  "  existing  word  list  with  pre-defined  or  user-defined  suffixes.  !  RT 
000380  For  the*,  1  RT 
000385  AT'(08,03),  !  RT 
000390  "  root  words  that  are  defined  as  the  more  common  parts  of  speech  !  RT 
000395  (noun, verns,",  !  RT 
000400  AT  (09,03),  !  RT 
000405  *  noun/verbs),  this  program  will  supply  suggested  suffixes.  For  !  RT 
000410  the  other*,  !  RT 
000415  AT  (10,03),  1  RT 
000420  "  root  words,  you  tray  enter  up  to  20  user-defined  suffixes.*,  !  RT 
000425  AT  (12,04),  !  RT 
000430  "Please  specify  tte  word  list  in  which  you  want  to  place  the  root!  RT 
000435  word*,  !  RT 
000440  AT  (13,04),  !  RT 
000445  "expansions,  if  these  defaults  are  not  satisfactory. ",  !  RT 
000450  AT  (16,33),  !  RT 
000455  "File  =*,  ,  !  RT 
000460  AT  ( 16, 43) , FAC( F$) , FILES  ,  Crf(08),  !  RT 
000465  AT  (17,33),  !  RT 
000470  "Library  =**,  !  RT 
000475  AT  (17,43) ,FAC(  If ) ,LId£  ,  Cri(08),  !  RT 
000480  AT  (18,33),  !  RT 
000485  'Volume  !  RT 
000490  AT  (18,43),FAC(V$),VDL$  ,  CH(06),  !  RT 
000495  AT  (  20, 19)  ,FAC(  Ei>) ,  ER$  ,  CH(46),  !  RT 
000500  AT  (23,11),  !  RT 
000505  "Press",  !  RT 
000510  AT  (23, 17), FAC! HSX{ 85) ) , ENTERS  ,  CHI05),  !  RT 
000515  AT  (23,23),  !  RT 
000520  "to  continue  or",  !  RT 
000525  AT  ( 23,38) ,FAC(HHX(84) J ,PF16$  ,  Cri(04),  !  RT 
000530  AT  (23,43),  !  RT 
000535  “to  return  to  th?  Master  Menu",  !  RT 
000540  KEYS(  dIN(  0)&;3IN(  16)  48IN(  32) ) ,  !  RT 
000545  ON  (  BXN(  16)  &8IN(  32)  )  0710  EXIT,  EXIT  RT 
000550  RT 
000555  ER$="  ":  Et«HEX(8C)  RT 
000560  /*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */  RT 
000565  /*  i-  t)v  file  exists  and  the  program  tray  continue  */  JM 
00057 0  /*  N-  the  file  doesn't  currently  exist;  you  tray  create  one  */  JM 


ZZU 


Technical  Report  86-0U1 


Wang  VS  Integrated  Editor  -  Version  6.10.00  13:41  11/13/84  Page  3 
Input  File  is  CRES0ERW  in  Library  CR£S@SRC  on  Volume  CRES02 

000575  /*  V-  t be  volume  supplied  doesn't  exist  or  is  not  mounted  */  RT 
000580  /*  L-  the  liorary  supplied  doesn't  exist  in  the  volume  given  */  RT 
000585  /*  E-  there  is  an  I/O  error  in  the  file  specified  */  RT 
000590  RT 
000595  ERS="Filo  not  found  in  Liorary/Volume. *  RT 
000600  CAIX  ’  LIMITS"  ( PILES, LIBS,  VOL$, CODES, ERS)  RT 
000o05  IF  CODES="Y"  THEN  RECtX  RT 
000610  IF  CODE$=’N*  THEN  GOSUB’ 7! ERS, HEX! 91) ,HEX( 81) ,HEX{ 81) )  RT 
000615  IF  OODE$="V“  THEN  GOSUB' 7iSTR! ERS, 3) ,K£X( 81) ,HEX( 81 ) , HEX( 91 ) )  RT 
000620  IF  COOE$=*L*  THEN  GOSUB' 7(STR( ERi, 3) ,HEX( 81) ,HEXi 91) ,H£Xl  81) )  RT 
000625  IF  CODE$="E"  THEN  GOSUb' 7(STR( ER$, 3) ,HEX(8l ) ,  H£k(  81) , HEX(  81 ) )  RT 
000630  GOTO  FILrtNU  RT 
000635  IOERR1:  PRINT  PAGE  RT 
000640  PRINT  KEX( 94) , "Error  occurred  on  file  FILES  RT 
000645  PRINT  HEX( 94) ,  "Error  code  =  FS(#1)  RT 
000650  STOP  "Touch  ENTER  to  return  to  menu.*:CLDSE  |1  RT 
000655  OPEN%(1)=0:  GOTO  FIU4NU  RT 
000660  RT 
000665  IUEKR2:  PRINT  PAGE  RT 
000670  PRINT  HEX( 94) , "Error  occurred  on  file  *;  FILS  RT 
000675  PRINT  HEX( 94) , "Error  code  =  ";  FS(#2)  RT 
000660  STOP  "Touch  ENTER  to  return  to  menu."  :CLOSE  §2  RT 
000685  OPEN% ( 2 ) =0 :  QOIO  FILMNU  RT 
000690  RT 
000695  IOERiU:  PRINT  PAGE  RT 
000700  PRINT  HEX( 94) , "Error  occurred  on  print  file  ";  FILS  RT 
000705  PRINT  HEX( 94), "Error  code  =  ";  FS(|3)  RT 
0007 1U  STOP  “l'ouch  ENTER  to  return  to  menu."  :CU0SE  #3  RT 
000715  OPEN4I  3)  =0 :  GOTO  FI  124140  RT 
000720  RT 
000/25  RT 
000730  RECCE:  CALL  "REAOFOR"  ADDR(  FIIJCS,  LIBS,  VOLS,0%,  "RS"  ,RSIZ%,R£T%)  RT 
000735  IF  RGr/,*=40  THEN  OK  RT 
000/40  ES=HEXl  94 )  ,  RT 
000745  ER$=  "File  t/pe  is  wrong  -  please  respecify."  RT 
000750  GOTO  FILMNU  RT 
000/55  RT 
000760  OK:./*  Create  a  new  data  file  for  expansions.  */  RT 
000/65  IF  F LAG=  1  LIEN  835  RT 
000/70  OF  I  LS= "ROOT#  t " :  DLl8$=Lld$  :iM9LS=VDLS  :I4=0  RT 
000775  C:  CONVERT  14  DO  S  TR(  OF  ItS,  5,  2) ,  PICiOO)  RT 
000/80  CALL  "LlMI Itl"( DF1LS, DL1BS,0WLS ,RCS)  RT 
000785  14=14*1  RT 
000790  IF  RCS="Y"  THEN  C  RT 
000/95  IF  OPEN 4 ( 2) =1  THEN  CLOSE  #2  RT 
000800  OPEN  NOGETPARM  #2,  OUTPUT,  FILEdlFILS,  LIBRARY^DLIdS,  RT 
000805  '/}LUME=DVOLS,SPACE=10U  RT 
000810  CIOSE  |2  RT 
000815  OPEN  NOGETPARM  02,  10,  SPACE^lOO,  EILE=DFIlS,  LI6RAKY=OLI6S,  RT 
000820  VOI,UME=D\AOL$  RT 
000825  OPEN 4 ! 2 ) =1  RT 
000830  RT 
0008  35  I?  OPEN4(l)  =  l  THEN  CLOSE  *1  RT 
000840  OPEN  NOGETPARM  #1, SHARED,  FILE*  FIIJCS,  LIBRARY  =  LIBS,  !  RT 
000845  VOLUME  =  VJLS  RT 
000850  OPEN  4 i 1 ) = 1  RT 
000655  RT 
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000860 

READ  |1, IOBUFFS 

RT 

000865 

IF  IOSUFFS="  COMMON  .TOROS"  THEN 

875 

RT 

000870 

MAND$=*"Mandatory  Technical  Word":  MS=HEX( 81 1  :GOIO  885 

RT 

000875 

MANDS=“  MS=rlEX(8L>) 

RT 

000880 

RT 

000885 

I08UFF$="  "  :Eit=H£X(8C) :ERit=*  " 

RT 

00089C 

SCREEN2:  Elf , PRTOS PCS , ROOTWDS = * 

*  :  EXPANDS! )=*  ES()=HEX(81) 

RT 

000895 

£S=KEX(  80 

RT 

000897 

PAS3WORD$=HEX( 00010F10111F20) 

JM 

000900 

WDSELr:  WDNO%=0 

JM 

000905 

ACCEPT 

RT 

000910 

AT  101,03), 

RT 

000915 

"CRES:  Root  Word  Expansion  Subsystem  (Word  Specific 

RT 

000920 

at  ion  Screen)", 

RT 

000925 

AT  (02,03), 

RT 

000930 

SSX  =  53S3S333S3Sa33Xaa3n3asa33S3S 

RT 

000935 

**MM**M*SM*  , 

RT 

000940 

AT  (04,02), 

JM 

000945 

"  Please  enter  a  root  word  and  select,  Dy  letter,  its 

correspondi 

RT 

000950 

ng  part  of*". 

RT 

000955 

AT  (05,03), 

RT 

000960 

"speech  as  listed  in  either  the 

coinmon  or  less  comixxi 

category. ", 

RT 

000965 

AT  (07,26), 

RT 

000970 

‘Root  word  =', 

RT 

000975 

AT  (07,39),  ROOTWDS 

,  CH( 20) , 

RT 

000980 

AT  (08,26), 

RT 

000985 

"Part  of  Speech", 

RT 

000990 

AT  ( 08, 41 ) ,FAC( HEX( 80) ) , 

PRJUSPCS 

,  Crtt'Ol), 

RT 

000995 

AT  (09,08),  FACIES), 

ER$  ,  C8( 65) , 

JM 

001000 

AT  ( 10, 21), FAC ( H£X( AD) ) , 

ITLE1S  ,  Cri(  0t>) , 

JM 

001005 

AT  ( 10, 55)  ,r’AC(  HEX(  AD)  ) , 

ITLE2S  ,  CH(ll), 

JM 

001010 

AT  (11,18), 

JM 

001015 

*N  =Noun 

3  =Article", 

RT 

00LO2O 

AT  (12,18), 

JM 

001025 

"V  =Verb 

I  =Inter jection". 

RT 

001030 

AT  (13,18), 

JM 

001035 

"n  =Noun/vero 

J  -Adjective", 

RT 

001040 

AT  (14,52), 

JM 

001045 

"C  “Conjunction", 

RT 

001050 

AT  (15,52), 

JM 

001055 

"P  “Preposition", 

RT 

001060 

AT  (16,52), 

JM 

001065 

*a  =Advero/vero", 

RT 

00 1070 

AT  (17,52), 

JM 

001075 

"A  “Adverb", 

RT 

001080 

AT  (18,52), 

JM 

001085 

*3  “Adjective/ verb", 

Rr 

001090 

AT  (19,52), 

JM 

001095 

"d  =Noun/adjective", 

RT 

001100 

AT  (21,30), 

Rr 

001105 

"Press", 

RT 

001110 

AT  (21,36),  FAC(  HEX(  85) ) , 

EN  TERS  , 

01(05), 

RT 

001115 

AT  (21,42), 

RT 

001120 

"to  continue". 

RT 

001125 

AT  (22,13), 

RT 

001130 

"Press", 

Rr 

001135 

AT  (22,19),  FAC( 8EX( 84 ) ) , 

PFlS 

01(03), 

RT 
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001140  Ar  [22,23),  I  RT 
001145  'to  view  the  definitions  of  tie  parts  of  speech’,  I  RT 
001150  Ar  [ 23, 17) ,  I  RT 
001155  'Cress',  1  RT 
001160  AT  [23,23), FAC l HEX ( 84 ) ) ,  PF15$  ,  CH(04),  I  RT 
001165  AT  (23,28),  I  RT 
001170  “to  return  to  the  List  Selection  Screen',  I  RT 
001175  AT  (24,28),  1  RT 
001180  "Press',  !  RT 
001185  AT  ( 24, 34) ,FAC(HKX( 84) ) ,  PF16$  ,  CH( 04) ,  1  RT 
001190  AT  (  24,39),  !  RT 
001195  'to  end  expansions',  RT 
001200  RETS (  PASSWORD!! ) ,  l  JM 
001205  KE¥(OPTION) ,  (  JM 
001210  Ofl(  BTNt  15)  &flIN(  3i)JulIN(  16)  6.BIN(  32) )  GOTO  ilLANKF, BLANK? ,  RT 
001215  PRINT_SCREEN  INIT, PKINT_SCrtEEN_INIT  RT 
001220  IF  OPriONOi  AND  0P1'I0N<>17  THEN  1235  RT 
001225  GOSUfl  DEFN :  GOTO  NDSELT  RT 
001230  RT 
001235  ER$=*  "  :Ej»HEX(  8C) :  E$( )  =ilEX(  81 )  :WDNO%=U  RT 
001240  IF  0PT10N=2  OR  OPTION=18  THEN  ONOOrtON  RT 
001245  FOR  1=  1  TO  LEN(ROOWD$)  RT 
001250  IF  POS("AaCDEFGHIJi<LMNOPURSTUVWXf2,'-'=SrR(ROO'WDt,I,l))>0  JM 
001255  THEN  1270  RT 
001260  ERi>=" Illegal  character  was  found  in  the  root  word-please  reenter"  RT 
001265  Et=HEX( 94) :  GOTO  NDSELT  RT 
001270  NEXT  I  RT 
001275  RT 
001280  K=  t«S( "NVnABCIJPajd"=PRTOSPC$)  RT 
001285  IF  KOO  THEN  1300  RT 
001290  ER$=«“Part  of  speecti  is  invalid  -  please  respeeif/.’  JM 
001295  Et=HEX( 94 ) :  GOTO  NDSELT  RT 
001300  READ  #2,  KEV=ROO'IWD$,  I08UFF$,B0D  GOTO  NOT  FOUND  RT 
001305  ER$=  ROOTWD£&"  is  already  in  the  list  -  press  PF2  for  more  sxpansl  JM 
001310  ions. ’ :E$=HEX( 94)  JM 
001312  PASSWORD$=HEX(0001020F10U121f20)  JM 
001313  GOTO  WDSELT  JM 
001315  NOT_FCXJND :  IF  K<4  THEN  EXPANSIONS  ELSE  UNCOMON  RT 
U01320  RT 
001325  dLANKF:  FlLEt-’  CLOSE  #1:  OPEN%(1)=0  RT 
U0I330  IF  OPEN*(2)=0  THEN  SCREEN1  RT 
001331  CLOSE  #2  RT 
001332  CALL  "SCRATCH"  ADDR(  "F*  ,DFlL$,DuItJ$,DVOU>,  "d"  )  RT 
001333  OPEN*(2)=0  RT 
001334  GOTO  SCREEN!  RT 
001335  RT 
001340  EXP, CIS  IONS:  RT 
U01345  EXPAN  Dt  1  )  =* "  '  RT 
001350  RT_LEN=LEN(RUOiWD$)  RT 
001355  IF  STR(  ROOIVfD$, RT_LEN)<> "  ¥"  THEN  1390  RT 
001360  EXPANDfct  i  )  =STR ( ROOTNDS , , RT  LEN-i  ) &'  IES"  RT 
001365  IF  A--  1  THEN  1450  "  RT 
001370  EXPANDS  (  2 )  =S  TR  ( ROOtV7D$ , ,  R  T  LEN-1 )  {,"  I  ED"  RT 
001375  EXPANDS!  3)  =ROOI\7D$Si"ING'  "  RT 
001380  GOTO  1450  RT 
001385  RT 
001390  IF  STR(ROOfWDl!,RT_LEN)<>'E"  THEN  1425  RT 


US 
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•  1 

001395 

EXPANDS ( 1)=’  * 

RT 

001400 

IP  K=  1  THEN  1450 

RT 

001405 

EXPANDS ( 2 ) =STR ( ROOTWDS , , RT  LEN) & 

*D" 

RT 

% 

001410 

EXPANDS! 3 ) =STR ( ROOTWDS , , RT  LEN-1 ) &’ IMG" 

RT 

1 

001415 

GOTO  1450 

RT 

\ 

001420 

RT 

001425 

EXPANDS ! 1 ) =ROOTWDS  6."  ES  * 

RT 

001430 

IP  K=*  1  THEN  J  450 

RT 

V* 

001435 

EXPANDS! 2) =ROOTWDS&"ED" 

RT 

001440 

EXPANDS!  3) =ROOTWDS&"  ING" 

RT 

1 

001445 

RT 

001450 

EXPANDS! 4)=RDOTWDSS,"S" 

RT 

1 

001455 

RT 

001460 

ES! )=HEX(8i) 

RT 

001465 

COMON: 

RT 

001470 

ACCEPT 

RT 

001475 

AT  [01,03), 

RT 

001480 

"CHES:  Hoot  Word  Expansion  Subsystem 

( Common  Category  Expa 

RT 

,  . 

001485 

nsion  Screen)’, 

RT 

1 

001490 

001495 

AT  '(02,03), 

RT 

’  - 

“  f 

001505 

AT  (04,04), 

RT 

001510 

’These  are  the  default  expansions 

Cor 

the  common 

root 

word  you' ve 

RT 

*■ 

001515 

entered. *, 

RT 

► 

001520 

AT  (05,04), 

RT 

if 

m 

001525 

’Please  modify  or  delete  any  incorrect  expansions 

« 

•  1 

RT 

1 

001530 

AT  (08,21), 

RT 

001535 

"The  root  word  was:", 

RT 

001540 

AT  (08,42),  PAC( HEX( 85) ) 

t 

HOOIWDS 

t 

CH ( 20 ) , 

RT 

001545 

AT  (09,21), 

RT 

001550 

"Part  of  speech  was:", 

RT 

001555 

AT  (09,42),  PAC( HEX! 84) ) 

/ 

PK'IDb'PCS 

r 

CH(i), 

RT 

001560 

AT  (13,23), 

RT 

■ 

001565 

"-S  expansion  is". 

RT 

001570 

AT  (13,41),  FAC ( ES !  4 ) ) 

t 

EXPANDS! 4) 

r 

CH( 20) , 

RT 

001575 

AT  (14,23), 

RT 

001580 

"-ES  expansion  is". 

RT 

001585 

AT  (  14,41),  FACl ESI  1 ) ) 

r 

EXPANDS! 1 ) 

r 

CH( 20) , 

RT 

001590 

AT  (  15,23), 

RT 

1/ 

001595 

"-ED  expansion  is". 

RT 

■ 

001600 

AT  (15,41),  P  AC  (  ES  (  2 )  ) 

/ 

EXPANDS  l  2) 

t 

CH(20), 

RT 

■ 

001605 

AT  (16,23), 

RT 

001610 

"-ING  expansion  is", 

RT 

001615 

AT  ( 16,41),  FAC( ESI  3) ) 

t 

EXPANDS! 3) 

r 

CH( 20) , 

RT 

001620 

AT  (19,12),  FAC(ES) 

ERS 

01(55), 

RT 

001625 

AT  (22,  30), 

RT 

• 

001630 

"Press" , 

RT 

001635 

AT  (22,36),  FAC(  HEX!  85) ) , 

ENTERS 

01(05), 

RT 

1 

l' 

001640 

AT  (22,42), 

RT 

001645 

"to  continue". 

RT 

f' 

001650 

AT  ( 23, 2J) , 

RT 

c 

001655 

"Press* , 

RT 

L* 

001660 

AT  (  23,29),  r’AOi  HrlX(  84) ) , 

PP2S 

t 

CHI  03) , 

RT 

V‘ 

001665 

AT  (  23,  33), 

RT 

f 

001670 

"to  add  user-defined  suffixes’. 

RT 

i 

001675 

AT  (24,15), 

RT 

U  4 


w. j- ---  :-t 


.'o'-'- 
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001680  'Press*,  !  RT 

001685  AT  (24,21),  FAC( HEX! 84) ) ,  PP15$  ,  CH(04),  !  RT 

001690  AT  (24,26),  !  RT 

001695  'to  reselect  the  uord  and/or  part  of  speech*,  RT 

001700  KEYS(BIN( 0) &3IN( 2) &3IN( 18) 6BIN! 15) &BIN( 31) ) ,  KET(OPTION),  •  RT 

001705  0N!BIN(  15)&BIN(  31))  OO-ID  SCREEN  2,  SCREEN2  RT 

001710  RT 

001715  ER$="  *:  £$=HEX(3C):  E$!)=H£X!81)  RT 

001720  FOR  1=  1  TO  4  RT 

001725  IF  EXPANDS! I)="  '  THEN  1760  RT 

001730  FOR  J=  1  TO  LEN( EXPANDS! I))  RT 

001735  IF  POS,  'AaCOEFGHIJKLmOPO^IUVWXyZ'-^STRtEXPANDtl  I)  ,J,1)  )>0  JM 
001740  THEN  1755  RT 

001745  ERS-" Illegal  character  found  in  expansion-please  modify."  RT 

001750  ES=H£X( 84) :  E$( I) =HEX( 91 ) :  GOTO  JOMGN  RT 

001755  NEXT  J  RT 

001760  NEXT  I  :  GOTO  1775  RT 

001770  RT 

001778  WDNO*=4  RT 

001780  IF  OPTIONS  OR  OPTION=18  THEN  UNC0M3N  RT 

001785  RT 

001790  ADDEXP:  RT 

001795  IF  ROOTWD$="  '  THEN  187b  RT 

001300  READ  #2,KE*=R001VJD$,BCM  GOTO  1820  RT 

001805  ERf=ROOTWD$&  “  has  already  been  added  to  the  expansion  list.'  RT 

001810  E$=HEX( 94) :  GOTO  1875  RT 

001313  RT 

001820  RIOEXPS="Root  Word:*  :  WORDS-  HOOIWDS;  ROOTS-'*'  RT 

001825  PPARTS , NEGS , T03ES , M IW$»*  '  RT 

001830  QDSU3  ATTRIBUTES  RT 

001835  IF  QPTION=0  THEN  1855  RT 

001836  EHi  =vWRD$  &  '  has  oeen  deleted  from  the  expansions."  JM 

001340  *ER$= EXPAND$( I ) &"  las  oeen  deleted  from  the  expansions."  JM 

001345  G3TO  1875  -  RT 

001850  RT 

001855  $PACK  ( F=F1$)  IOBUFFS  FROM  WORDS,  PRIOSPCS,  PPARTS,  1  RT 

001860  NEGS, TUBES, ROOTS, MTWS  RT 

001365  WRITE  12,  IOBUFFS,  DATA  GOTO  IOERR2  RT 

001870  RT 

001375  RTOEXPS*" Expansion: "  RT 

001880  RT 

001885  FOR  1=  1  TO  WDNO%  RT 

001890  IF  EXPANDS! I ) =  '  "  THEN  i960  RT 

001395  RT 

001900  READ  *2,  XEy=EXPA14D$(  I) ,  BOO  GOTO  1920  RT 

00190b  ERS=EXPANOS! I ) 6  "  has  already  oeen  added  to  the  expansion  list."  RT 
001910  E$=HEX( 80  :  GOTO  1930  RT 

001915  RT 

00192J  PR  »  HPCS,  NEGS,  PJa c-S ,  ROT 7$ ,  MTWS = *  "  RT 

001925  L=r.£Ni  EXPANDS!  I)  )  RT 

001930  IF  STR(  EXPANDS!  I),  L-1,U='ED"  THEN  1932  RT 

001931  PPAH'IS-*  *:  GOTO  1935  RT 

001932  PPART$=*  ** :  PRTOSPC$»"V"  RT 

001935  WJRDS=EXPANDS( I) :  GOSUB  ATTRIBUTES  RT 

001940  IF  OPTION=2  OR  OPTION-18  THEN  1975  RT 

001945  RT 

001950  Stack  (f=fiS)  iobuffS  from  vwrdS,  priospcs,  pparts,  :  rt 


//b 
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001955  NEG*,TOBE*,RGOT*,MTW*  RT 
001960  WRITE  #2,  IOBUFF*,  DATA  GOIO  IOERR2  RT 
001965  GOTO  1980  RT 
001970  RT 
001975  ER*=SXPAND*( I ) &"  has  been  deleted  from  the  expansions."  RT 
001980  NEXT  I  RT 
001985  RT 
001990  GOTO  SCREEN2  RT 
001995  RT 
002000  UNCOMON:  RT 
002005  ACCEPT  !  RT 
002010  AT  (01,03),  !  RT 
002015  "CRES:  Root  Word  Expansion  Suosystem  (User-defined  S*.  RT 
002020  uffix  Screen)",  !  RT 
002025  AT  (02,03),  I  RT 

002035  =============",  ■  RT 

002040  AT  (04,04),  •  RT 
002045  *  The  fields  Delow  have  oeen  provided  for  user-defined  suffixes.!  RT 
002050  Please",'  !  RT 
002055  AT  (05,04),  !  RT 
002060  "enter  any",  !  RT 
002065  AT  (05,14),  FAC( HEX( 84) ) ,  EXP*  ,  CH(09),  !  RT 
002070  AT  (05,24),  !  RT 
002075  "you  want  to  appear  in",  1  JM 
002080  AT  (05,46),  FAC(HEX( 85) ) ,  FILE*  ,  CH(08),  !  RT 
002085  AT  (05,55),  !  RT 
002090  ".  This  screen  has  been",  !  RT 
002095  AT  (06,04),  !  RT 
002100  "provided  to  enaoLe  you  to  enter  the  less  common  expansions  of  yo!  RT 
002105  ur  choice.",  !  RT 
002110  AT  (10,26),  !  RT 
002115  "Expansion  1",  !  RT 
002120  AT  (10,38),  FAC(  E*(WDNO%+T  )),  SXPAND*(WDNO%+l)  ,  CH(20),  !  RT 
002125  AT  (11,26),  !  RT 
002130  "Expansion  2",  !  RT 
002135  AT  (11,38),  FACl  E*(  WUN04+2  )),  EXPAND*(WDNO*+2)  ,  CH(20),  !  RT 
002140  AT  (12,26),  !  RT 
002145  "Expansion  3",  !  RT 
002150  AT  (12,38),  FAC(E*(  WDNO'»t3  )),  EXPAND* ( WDNO* +■ 3 )  ,  CH(20),  !  RT 
002155  AT  (13,26),  !  RT 
002160  "Expansion  4",  !  RT 
002165  AT  (13,38),  FAC(E*(  WDNO%t4  )),  EXPAND*! WDNO* +4)  ,  CH(20),  ‘.  RT 
002170  AT  (14,26),  !  RT 
002175  "Expansion  5",  !  RT 
002180  AT  (14,38),  FAC(E$(  WDNO*(5  )),  EXPAND* (WDNO% +5)  ,  CH(  20) ,  !  RT 
002185  AT  (18,14),  FAC(Et),  ER*  ,  CH(56),  1  RT 
002190  AT  (22,  30),  !  RT 
002195  "Press",  !  RT 
002200  AT  1  22, 3b) ,  FAC(  HEX(  83)  ) ,  ENTER*  ,  01(05),  !  RT 
002205  AT  (22,42),  !  RT 
00 22LO  "to  continue",  !  RT 
002215  AT  (23,20),  !  RT 
002220  "Press",  !  RT 
002225  AT  (23,26),  FAC(  HEX!  84) ) ,  PF2*  ,  CH(03),  !  RT 
UU2230  AT  (23,30),  !  RT 
002235  "to  add  more  user-dot  mod  suffixes’,  !  RT 


il 
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002240 
002245 
002250 
002255 
002260 
002265 
002270 
002275 
002/80 
002285 
002290 
002295 
002300 
002305 
0 j  2310 
002315 
002320 
002325 
002330 
002335 
002340 
002341 
002342 
002345 
002350 
002360 
002365 
002370 
002375 
002380 
002385 
002390 
002395 
002400 
002405 
002410 
002415 
002420 
002425 
002430 
002435 
002440 
002445 
002450 
002455 
002460 
002465 
002470 
002475 
002480 
002485 
002490 
002495 
002500 
002505 
002510 
002515 


AT  (24,15),  l 

"Press",  ! 

AT  (24,21),  FAC( HEX(  84) ) ,  PF15S  ,  CH(04>, 

AT  (24,26),  I 

"to  reselect  the  word  and/or  part  of  speech*  ,  I 

KEYS(aiN(0)&3IN(2)SaiN(18)&aiN(iS)Sd3IN(31)),  KEYlOPTION), 

0(4  (81N(  15)&BIN(  31) )  GOTO  SCREEN2,SCREEN2 


ER$»*  "  :ES=HEX(  80  :ES(  )=HEX(  81) 

FOR  I=(WDNO%+l)  TO  ( W1)N0%  +5 ) 

IF  EXPANDS(I)="  "  THEN  2330 
FOR  J=  1  TO  LBN ( EXPANDS ( I ) ) 

IF  POS("ABa}£FGHIJKLrtNOPL>3SIWWXYZ‘-"=STR(EXPANDS(I),J,l))>0  I 
THEN  2325 

£RS="Illegal  character  found  in  expansion  -  please  modify." 
E$=HEX(  84)  :  E$(  I )  =HEX(  91 ) :  GCrTO  UNOOMON 
NEXT  J 
NEXT  I 

< 

IF  WDNO%<ll  THEN  WDNO%»WDNO% f 5 

IF  I>=20  AND(OPTION=2  OR  OPTION=18)  THEN  £Rf="Thi  system  allows  ol 
nly  20  expansions  per  word  per  trial." 

IF  OPTION=2  OR  OPi’ION=18  THEN  UNCOMON 
GOTO  ADD  EXP 


ATTRIBUTES: 

IF  MANDSO"  "THEN  ITLE9$=“(*  or  NO  ENTRY)*  ELSE  ITLE9S="  " 

I  TEE 3S  ="CURRENT  ATTRIBUTES" 

ITLE4S  =" LEGAL  ENTRIES" 

ACCEPT 

AT  (01,03), 

"CRES:  Root  Word  Expansion  SuDsystem  (Attrioute  O 

ption  Screen)", 

AT  (02,03), 


AT  (04,03), 


"Please  specify  the  oroper  attrioutes  for  this  expansion  to  tie  en 
tered  into", 

AT  (05,03),  FAC( HEX( 85) ) ,  FILES  ,  CH(08), 

AT  (05,12), 


AT  (07,30),  FAC( HEX! AD) ) , 
AT  ( 0 /, 60 ) ,  FAC( HEX( AD) ) , 
AT  (09,07),  FAC(  HEX!  80  ) , 
AT  (09,20),  FAC( HEX( 85) ) , 
AT  (09,60), 

! A-2-' ) "  , 

AT  (11,07), 


ITLE3S 
I TLE4S 
RTOEXPS 
WORDS 


,  CHI  18) , 

,  01(13), 

,  CH(10), 

,  Cri(20), 


"Part  of  Speech", 

AT  (11,39),  FAC( HEX( 80) ) ,  PRTOSPCS  ,  CH(01), 

AT  (11,60), 

"(ABCIJNOPVajnd)", 

AT  (12,07), 


"Past  Participle", 

AT  (12,39),  P PARTS  ,  CH(01), 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

JM 

JM 

RT 

RT 

RT 

RT 

JM 

JM 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

JM 

JM 

RT 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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002520 

002525 

002530 

002535 

002540 

002545 

002550 

002555 

002560 

002565 

002570 

00257b 

002530 

002585 

002590 

002595 

002600 

002605 

002610 

002615 

002620 

002625 

002630 

002635 

002640 

002645 

002650 

002655 

002660 

002665 

002670 

002675 

002630 

002685 

002690 

002695 

002700 

002705 

002710 

002715 

002720 

002725 

002730 

002735 

002740 

002745 

002750 

002755 

002760 

002765 

002770 

002775 

002780 

002785 

002790 

002/95 

002300 


,  Cri(Oi), 


,  Cti(  01) , 


MAi  JDS 
MIV/S 


01(24), 

,  CH(01), 


AT  (12,60), 

•(*  or  NO  ENTRY)", 

AT  (13,07), 

“Negative" , 

AT  (13,39),  NEG$  ,  Cri(01), 

AT  .13,60), 

“(*  or  NO  ENTRY)', 

AT  (14,07), 

“To  Be", 

AT  (14,39),  TOMES  ,  Cri(Ol), 

AT  (14,60), 

"(»  or  NO  ENTRY)', 

AT  (15,07), 

“Root  Word", 

AT  (  15,39),  ROOTS  ,  00(01), 

AT  (15,60), 

'(*  or  NO  ENTRY)’, 

AT  (16,07),  PAC(  tlEXi  80 ) ,  MAUDS  ,  01(24) 

AT  (16,39),  FAC(MS),  MTWS  ,  CH(0 

AT  '(16,60), 

FAC  ( REX  (  30  ) ,  I  TLE9S,  CH(  15), 

AT  (18,10),  FAC(ES),  ERS  ,  CH 

AT  (21,30), 

“Tress', 

AT  (21,36),  FAC( HEX( 85) ) ,  ENTERS  ,  CH( 

AT  (21,42), 

“to  continue*, 

AT  (22,13), 

"Press', 

AT  (22,19),  FAC( HEX( 84 ) ) ,  PF1S  ,  CH( 

AT  (22,23), 

"to  view  the  definitions  or  die  parts  of  speech ", 

AT  (23,24), 

"Press", 

AT  (23,  30),  FACi  rlEX(  84 )  ) ,  PF2S  ,  CH(04 

AT  (23,  34), 

"to  delete  ttus  expansion", 

AT  (24,22), 

“Press", 

AT  (24,28),  FAC( HEX( 84 ) ) ,  PF16S  ,  CH(04 

AT  (24,33), 

“to  return  to  the  Master  Menu", 

KEYS (B IN (  0)  f»8IN(  1)  &3IN(  17) &BIN( 2) &BIN!  18)&8IN(  16)iBIN(  32)  ) , 
KEY  (OPTION), 

ON(BIN(  I6)&BIN(  32)  )  GOTO  SCRATCH  FILE,SOiA TCHFILE 
IF  OPTION  =  1  OR  OPTION  *17  THEN  GOSUB  DEFN 

IF  OPTION  =1  OR  OPTION  =17  THEN  GOTO  A  TIKI  BOTES 


,  CH( 60) , 


ENTERS 


,  CHi  05) , 


,  CH(  03) , 


,  CH104), 


,  CH( 04 ) , 


IF  OPTION=2  OR  OPTION=18  THEN  RETORN 
ER$=“  '  :  ES=HEX(  80 

/*  Check  for  validity  of  entries  */ 


IF  POS(  “AdCIJNOPVadjn"=PRTOS?CS)>0  THEN  NEXT1 
ERS  =  “Part  of  Speech  value  is  illegal." 

S$  =  HEX( 94 ) 

GOTO  ATTRIBUTES 


I 
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002805  NEXT!: 

002810 
002815 
002820 

002825  NEXT 2 : 

002830 
002835 
002840 

002845  NEXT3: 

002850 
002855 
002860 

002865  NSXT4 : 

002870 
002875 
002880 

002885  NEXi'5 : 

002890 
002895 
002900 

002905  RETURN 
002910 
002915  DEr’N : 

002920  ACCEPT 
002925  Ai‘  £  01,01) , 

002930  ’ CRES :  Root  Word  Expansion  Suos/stem  (Definition  ot' 

002935  Entries  Screen)’, 

002940  AT  i  02,01)  ,*--  =  ■====-  =  -==== ===-============ ============== 

002945  =====================»======*==33=" , 

002950  AT  (03,08),  FAC(  tl£X(  AD) ) ,  ITLE5S  ,  Cri  ( 1 4  > , 

002955  AT  (05,49),  FAC( HEX( AD) ) ,  ITLE6$  ,  Crf(iO), 

002960  AT  (07,03),  ?AC( HKX( 84) ) ,  ?$(i)  ,  CH(03), 


002965  AT  t'U/,08), 

002970  ’Adjective  . Modifies  a  noun  ot  pronoun’, 

002975  AT  (08,03),  FAC( HKX( 84) ) ,  P$(2)  ,  Cri (  0 3 ) , 

002980  AT  (08,08), 

002985  "Ad j active/ veto . A  word  ttat  nay  function  as  an  adjective 

00299U  or  veto*, 

002995  AT  (09,03),  FAC( HEX( 84 ) ) ,  P $13)  ,  CH(03), 

00  )000  AT  (09,U8), 

003005  "AdvetD  . Modifies  a  vero,  adjective,  or  advert)*, 

003010  AT  (10,03),  FAC( KEX( 84 ) ) ,  P$(4)  ,  CH(03), 

0030L5  AT  ( 10, 0d) , 

003020  ’Adveco/vetD  . A  word  tint  nay  function  as  an  advero  or 

00302 5  vero*, 

003030  AT  (11,03),  FAC( HEX( 84) ) ,  P$(5)  ,  01(03), 

003035  AT  ( 1 1 , Od) , 

003040  ’Article  . A  limiting  adjective  oet'ore  a  noun  (e.g. 

003045  a,  t)>e)*, 

003050  AT  (12,03),  FAC(  HEX(  84 )  ) ,  P$(6)  ,  01(03), 

003055  AT  ( 12,08) , 

003060  ’Conjunction  . Linns  plirases  or  clauses  (e.g.  or)’, 

003065  AT  (13,03),  r AC( HEX* 84 ) ) ,  P$(7)  ,  CH(03), 

0030  /0  AT  ( 13,08) , 

003075  *  Inter  joction  . Jsed  for  smyle  exclamations  (e.g.  On!)" 

00  3080  , 


003035  A  i’  £  14,03) ,  FAC  l  HEX(  84  ) ) ,  P£(8)  ,  Cri£03), 


IF  iOSC  *"=PPART$)>0  MEN  NEXT2 

ER$  =  ’Past  Participle  value  is  illegal.* 

E$  =  riiEXC  94 ) 

GOTO  ATTRIBUTES 

IF  POS("  ‘*=NEG£)>0  THEN  NEXT3 

ER$  =  *  Negative  value  is  illegal.’ 

E£  =  HEX( 94) 

GOTO  ATTRIBUTES 

IF  POS(*  *’=TOB££)>0  THEN  NEXT4 
ERt  =  ’  To  Be  value  is  illegal." 

£$  =  HEX (94) 

GOTO  ATTRIBUTES 

IF  POS("  *"=MTW£)>0  THEN  NEXT5 

ERf  =  "Mandatory  word  value  is  illegal." 

B$  =  HEX( 94) 

GOTO  ATTRIBUTES 

IF  POS("  *’=ROOTt)>0  THEN  2905 

ER$  =  "  Root  word  value  is  illegal." 

E$  =  HEX(  94) 

CjDTO  ATTRIBUTES 


RT 

Hi’ 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

rt 


JM 

JM 


JM 

JM 


zzy 
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003090  AT  (14,08),  1 

003095  "Noun  . Indicates  a  person,  place,  or  thing",  I 

003100  AT  (15,03),  FAC(  HEX(  84)  ) ,  P$(13)  ,  CH[03),  ! 

003105  AT  (15,08), 

003110  "Noun/ad jective . A  word  that  may  function  as  a  noun  or  ad! 

003115  jective",  * 


003120 

AT  ( 16,03), 

FAC ( HEX ( 84) ) , 

P$(  9) 

,  CH( 03) , 

003125 

AT  (16,08), 

003130 

"Noun/verb  . 

tray  function  as 

a  noun  or  verb 

003135 

m 

t 

003140 

AT  (17,03), 

FAC ( HEX ( 84) ) , 

P$(10) 

,  CH( 03) , 

003145 

AT  (17,08), 

003150 

"Preposition  . 

a  relationship  between  two  ele 

00_<i55 

ments  of  ", 

003160 

AT  (18,08), 

003165 

* 

a  sentence  (e.g.  in,  on. 

by,  to,  since) 

JM 

003170 

m 

t 

003175 

AT  (19,03), 

FAC( HEX{ 84) ) , 

Pit  11) 

,  CH( 03) , 

003180 

AT  (19,08), 

003185 

"Pronoun  / . 

may  be  used  as 

a  suDStitute  fo 

003190 

r  a  noun" , 

003195 

AT  (20,08), 

003200 

« 

(e.g.  I,  you,  she,  what,. 

...)", 

JM 

003205 

AT  (21,03), 

FAC( HEX( 84) ) , 

P$(12) 

,  CH( 03) , 

003210 

AT  (21,08), 

003215 

"Verb  . 

003220 

AT  (23,20), 

003225 

"Press" , 

003230 

AT  (23,  26), 

FAC( HEXi 84) ), 

PF 1$ 

,  CH[ 03) , 

003235 

AT  (23,  30), 

003240 

"to  return  to  the  previous  screen". 

003245 

KEYS( BIN( 1 ) &3IN(  17) 

) 

RT 

003250 

RETURN 

RT 

003255 

/ 

Rf 

003260 

PRINT  SCREEN  IN IT: 

FLAG3!  :ERi="  ": 

Ei=REX(8D) 

RT 

003265 

PRINT  SCREEN: 

RT 

003270 

ACCEPT 

RT 

003275 

AT  (01,03), 

RT 

003280 

"CRES:  Root  Word  Expansion  Suosystem  (Print,  Display  or  Merge  B 

RT 

0U3285 

.R.W.  Option)", 

RT 

003290 

nni?Q^ 

AT  (02,03), 

RT 

003300 

• 

RT 

AT 

003305 

AT  (04,03) , 

RT 

003310 

"Since  you  have  coiipleted  the  root 

word  expansion 

list,  please  en 

RT 

003315 

ter  tha". 

RT 

003320 

AT  (05,03), 

RT 

003325 

"appropriate". 

RT 

003330 

AT  (05,15), 

FAC( HEX( 85) ) , 

PFKEYi 

,  CH( 06) , 

RT 

003335 

AT  (05,22), 

RT 

003340 

"  corresponding  to 

one  of  the  following  operations 

.  ■ 

•  f 

RT 

003345 

AT  (07,10), 

F  AC ( E$ ) , 

ER$ 

,  CH( 65), 

RT 

003350 

AT  (09,17), 

FAC( HEX( A5) ), 

PF$ 

,  CH( 02) , 

RT 

003355 

A T  (09,24), 

F  AC ( HEX ( AC ) ) , 

OPERATIONS 

,  CH (27), 

RT 

003360 

AT  (10,17), 

FAC( HEX( 84 ) ) , 

Ai$ 

t 

RT 

003365 

AT  (10,24), 

RT 

003370 

"Display  root  word 

expansions" , 

RT 
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AT  (11,17),  PAC( HEX( 84) ) ,  A2$ 

AT  (11,24), 

"Print  listing  of  root  word  expansions", 

AT  (12,17),  PAC( HEX! 84) ) ,  A3$  , 

AT  (12,24), 

"Merge  root  words  into", 

AT  (12,46),  FAC( HEX( 85) ) ,  FILES  ,  CH(08), 

AT  (14,17),  FAC( HEX( 84) ) ,  A15$ 

AT  (14,24), 

"Add  or  modify  root  word  expansions  Defore  merging  lists", 

AT  (15,17),  FAC( HEX( 84) ) ,  Al6$  , 

AT  (15,24), 

"Exit  the  program  without  merging  expansions", 

AT  (18,03), 

"This  optional  suotitle  may  oe  used  to  identify  a  root  word  expan 
sion  list", 

AT  (19,03), 

"that  las  been  queued  to  the  printer.*, 

AT  (21,14), 

"SUBTITLE  , 

AT  (21,27),  FAC( HEX( 81) > ,  SUB1S  ,  CH(23), 

AT  (22,27),  PAC(  HEX(  81) ) ,  S0B2$  ,  CH(23), 

Kh'yS(HEX(  000111021203130F1F1020) )  ,  KEfiOPTION) , 
ON(BIN(16)&BIN(32))  GOTO  SCRATCH  FILE, SCRATCH  FILE 

ERt="  ":E$=HEX(8C):WORD$,PRIUSPC$=*  " 

IF  OPTIONS  OR  OPTION  =17  THEN  VIEW 
IP  OPTION^ 2  OR  OPTION  =18  THEN  VIEW 
IF  0PTI0N=3  OR  OPTION  =19  THEN  MERGE 
IF  OPTION=>15  OR  OPTION=31  THEN  MODIFY 
GOTO  PRINT  SCREEN 


=“ OPERATION" :ROOTWDt=* 


003375  AT 

003380  AT 

003385  "Print  lis 
003390  AT 

003395  AT 

003400  "Merge  roo 
003405  AT 

003410  AT 

003415  AT 

003420  "Add  or  mo 
003425  AT 

003430  AT 

003435  "Exit  the 
003440  AT 

003445  "This  opti< 
003450  sion  list" 
003455  AT 

003460  "that  las  I 
003465  AT 

003470  "SUBTITLE:’ 
003475  AT 

003480  AT 

003485  KSyS(HEX(0' 
003490  ON( BIN ( 16) 
003495 

003500  ERj>="  "  :E£ 
003505  IF  OPTION 
003510  IP  OPTION 
003515  IF  OPTION 
003520  IF  OPTION 
003525  GOTO  PRIN 
003530 

003535  MODIFY: 
003540  OPERATIONS 


,  CH(  23) , 
,  CH( 23) , 


003545 

003550 

003555 

003560 

003565 

ACCEPT 

AT  (01,03), 

"CRES:  Root  Word  Expansion  Suusystem 
nsion  Screen)’, 

AT  (02,03), 

(Modify  Expa 

RT 

RT 

RT 

RT 

RT 

003575 

Rr 

003580 

AT  (04,03), 

RT 

003585 

*  Please  enter  the 

word  you  want  to 

modify  and  select 

the  appropr 

RT 

003590 

iate’ , 

RT 

003595 

AT  (04,72), 

FAC( HEX( 85) ! , 

PFKEY$ 

,  CH( 06) , 

RT 

003600 

AT  (04,79), 

RT 

003605 

m  n 

•  t 

RT 

003610 

AT  (08,28), 

RT 

003615 

"Word  =", 

RT 

003620 

AT  (08,35), 

FAC( HEX(  81)), 

WORDS 

,  Cri( 20) , 

RT 

003625 

AT  (10,25), 

FAC (  E$ ) , 

ER$ 

,  CH( 55) , 

RT 

003630 

AT  (12,29), 

FAC( HEX( A5) ) , 

PF$ 

,  CH( 02) , 

RT 

003635 

AT  (12,36), 

FAC  (  HEX  ( AO )  ) , 

OPERATIONS 

,  CH (15), 

RT 

003640 

AT  (13,29), 

FAC( HEX( 84) ) , 

Al$ 

t 

RT 

U03o45 

AT  (13,36), 

RT 

003650 

"Add  an  Expansion", 

RT 

003655 

AT  (14,29), 

FAC( HEX( 84 )  ) , 

A  2$ 

t 

RT 
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003660 

003665 

0036/0 

003675 

003680 

003685 

003690 

003695 

003700 

003705 

003710 

003715 

003720 

003725 

003730 

003735 

003740 

003745 

003750 

003755 

003760 

003765 

003770 

003775 

003780 

003785 

003790 

003795 

003800 

003805 

003810 

003815 

003820 

003825 

003830 

003835 

003840 

003845 

003850 

003855 

003860 

003865 

003870 

0038/5 

003880 

003885 

003890 

003895 

003900 

003905 

003910 

003915 

00  3920 

003925 

0U3930 

00  39  35 

00  3940 


AT  (14,36), 

"Delete  the  Word", 

AT  (15,29),  FAC(  HEX(  84)  ) ,  A3S 

AT  (15,36), 

"Modify  the  Word", 

AT  (17,29),  FAC( HEX( 84) ) ,  A15S  , 

AT  (17,36), 

"End  Modifications", 

AT  (18,29),  FAC(tlEX(  84) ) ,  A16$  , 

AT  (  18,36), 

"Return  to  the  Master  Menu", 

KEYS( HEX( 000111021203130F1F1020) ) ,  KEY (OPTION) , 

ON( 8IM( 15) &QIN( 31) &BIN( 16) &8IN(  32) )GOTO  PRINT_SCR6EN_  INIT, 

PRINT  SCREEN  INI  T,  SCRATCHF I LE ,  SCRATCH  FILE 

ER$="  “ :ES=HEX(8C) 

FOR  1=  I  TO  LEN(WORDS) 

IF  POS("ABCDEFGHIJKU4N0PO3STUVWXyz,-"=STR(W0RDt,  !,!))>  0  THEN 
3770  ' 

ERS=  "Illegal  character  found  in  word  -  please  respecify." 
E$=I1EX(94)  :GOTO  MODIFY 
NEXT  I 

READ  *2,  HOLD,  KEY=WORD$,  IOBUFFS,  BOD  GOTO  3825 
IF  OPTION*  2  OR  OPTION*  18  THEN  3810 
IF  OPTION*  3  OR  OPTION*  19  THEN  3895 

ERS="  "MtoRDfcS."  already  exists  in  the  list.  ’  :E$=HEX(  94) 

GOTO  MODIFY 

DELETE  #2:  ER$="  “  4.  WORDS&"  has  been  deleted.":  E$*HEX(8D) 

WORD$="  " :  GOTO  MODIFY 

IF  OPTION  Ol  AND  0PTI0NO17  THEN  ER1 
PRTOS  PCS ,  PPARTS , N0G$ , TOBES ,  ROOTS ,  M'IW$ = "  " 

GOSU8  ATTRIBUTES 

IF  OPTION*2  OR  OPTION=18  THEN  3880 

SPACK  ( F=F1S)  IOBUFFS  FROM  WORDS,  PRTOSPCS,  PPARTS, 

NEUS ,  TOBES ,  ROO  TS ,  MIWS 
WRITE  #2,  IOBUFFS,  DATA  GOTO  IOERR2 
ERS-WDRDS&"  tus  been  inserted."  :ES=HEX( 80 
GOTO  .MODIFY 

EhS=WORdS&"  has  Deen  deleted  from  tlie  expansions." 

GOTO  MODIFY 

SUNPACK ( F*F1S )  IOBUFFS  TO  WORDS,  PRTOSPCS,PPARTS,NEGS,TOBES, 
ROOTS, MTWS 
GOSUB  ATTRIBUTES 

IF  OPT  ION*  2  OR  OPTION=18  THEN  3810 

SPACK  ( F=F1S)  IOBUFFS  FROM  WORDS,  PRTOSPCS,  PPARTS, 

NEGS , TOBES , ROOTS , MTWS 

REWRITE  12,  IOBUFFS,  DATA  GOTO  IOERR2 

ERS="  "&WORDS&  "  tus  been  updated.":  ES=HEX(SD) 

GOTO  MODIFY 


•3 
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003945 

003950 

003955 

003960 

003965 

003970 

003975 

003980 

003985 

003990 

003995 

004000 

004005 

004010 

004015 

004020 

004025 

004030 

004035 

004040 

004045 

004050 

004055 

004060 

004065 

004070 

004075 

004080 

004085 

004090 

004095 

004100 

004105 

004110 

004115 

004120 

004125 

004130 

004135 

00414U 

004145 

004150 

004155 

004160 

004165 

004170 

004175 

004180 

004185 

004190 

004195 

004200 

004205 

004210 

004215 

004220 

004229 


ER1 :  ER$="  "&WORD$&"  does  not  exist  in  this  list." 

Ei>=HEX(  94 )  :  OOTO  MODIFY 


VIEW: 

/*  Mow  it's  time  to  generate  our  print  file  name  */ 

LPP*=50 
QAT$=  DATE 

ST8(DAT$,  3, 2) &"/"  &STR(  DAT$,  5,2)6"/"  &6TRi DAT$,  1,2) 
1-$=  STR(  TIME,  1, 2)  S,"  :  *  &STR(  TIME,  3,2) 

PFILE$="ROOT|#" 

I*=U 

NEXT14:  CONVERT  I*  TO  STR( PFILEf, 7,2), PIC( 00) 

I %— I%+1 

CALL  "LIMITS"  ( PFIL£$,SLIB$  ,SVOL$,  CODES, ERt) 

IF  CODES=“Y"  THEN  NEXT 14 

DISPLAY 

AT  (01,03), 

"CRES:  Expanded  Root  Word  Print  Subsystem", 

AT  (01,61), 

"(Generation  Screen)", 

AT  (02,03), 


AT  ( 12*  23) ,  ! 

"Output  file  now  being  generated:* 

OPEN  NOGETPARM  »3, OUTPUT, FII,E=PFILE$, LI8RARY=SLI6$,  1 

VOLUME =S  VOu$ , S  PACE= 1 5000 
GOSJA  TTL  PGE 
STAjITPHS  =  ALL(  HEX(  00) ) 

PAGE*  =  l 
Gi)S JO  FIRST 

RECS4  =  0  , 

READ  |2,  XEO=SrARTPHS,  I08UFFl>,  EOD  GOlO  HOME 
KNOT:  PSN=»  P0S("JVCjN0InAP8ad"=  STR(  I08UFFS, 21,1)) 

IF  PSN=0  THEN  PSN=14 

IF  PSN  =  14  THEN  A$(  14)  =STR(  IOdUFFfc,  21, 1 ) 

IF  OPTION=l  OR  OPTION=17  THEN  DISPFIL 
WRITE  #3,  USING  IMG6,C$,  "  * ,STR( IOBUFF$, 1, 20) ,  I 

A$(  PSN) ,STR(  IOBUFFS,  22,  1)  ,S'TR(  IOBUFFS,  24,1),  I 

S TR (  I08UFFS ,  23, 1 )  ,STR(  IOtJUFFS,  27,1) 

IF(STR(  IOBUFFS  ’’A,  1)<>  JTHEN  AGAN 
CS=HEX( U000) 

WRITE  #3,  USINo  IMo?  C$,STR( IOOOFFS, 1,20) 

WRITE  *3,  USING  IMG9,  C$,STR( IOBUFFS, 1, 20 ) 

C$=HEX( U001 ) 

GOIO  AGAN 

DISPFIL:  IF  STR(  IOBOFr$,26,l)  =  ’»"  THEN  STR(  IOBUFFt,  2b,  I )  ="  f " 

WRITE  #3,  USING  IMG6, C$,STR(  I03UFF$, 26,1) ,STR( IOBUr F$, 1,20),! 
Ai>( PSN) ,STR( I08UFFS, 22, 1 )  ,STR( IOOUFFS, 24,1),  I 

S'TR(  I08UFFS, 23,1)  ,STR(  IOBUFFS,  27, 1 ) 

AGAN :  IF  RSCS*=LPi>*  THEN  RECS%=1 

READ  <2,  IOSUFFf , fcijj  OOTU  HOME 
IF  RECS*  =  1  AND  PAGE* <21  THEN  GOSiJA  HEADER 
RECS  * -REGS  * 1 1 
G  >TJ  KNOT 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 


Z33 
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004230 

HOME: 

IP  RECS%<2  THEN  RECS»=LPP» 

RT 

004235 

WRITE  |3,  USING  TIT,  C$ 

RT 

004240 

RECS%=RECS%+2 

RT 

004245 

WRITE  #3,  USING  DG,  Cl 

RT 

004250 

FOR  I  =  RECS*  TO  LPPi 

RT 

004255 

WRITE  #3,  USING  TIT,  Cl 

RT 

004260 

NEXT  I 

RT 

004265 

IF  OPTION=2  OR  OPTION=18  THEN  HER! 

RT 

004270 

WRITE  #3,  USING  IMG8,  Cl 

RT 

004275 

GOTO  HER 

RT 

004280 

HER1: 

WRITE  #3,  USING  ROT,  Cl 

RT 

004285 

WRITE  #3,  USING  ROT1,  HEX(0000) 

RT 

004290 

WRITE  13,  USING  ROT1,  HEXiOOOO) 

RT 

004295 

HEW: 

CLOSE  #3 

RT 

004300 

IF  OPTION =2  OR  OPTION=18  THEN  MESS 

RT 

004305 

CLOSE  WS 

RT 

004310 

MSG 2$  =  "CANCEL,  Processing" 

RT 

004315 

MSK|=HEX(00> 

RT 

004320 

CMSGl  *  "  " 

RT 

004325 

CALL  "LINK"  ADDR!  "DISPPILE"  ,  *P"  ,RLlBi,R\AJLl,  34,  PFILEI, 

RT 

004330 

SLIBl,S\«L6,"C*,MSG2l,27%,"H*,MSKi,CMSGI,255*,C*,R4) 

RT 

004335 

ER$  =  "  " 

RT 

004340 

IF  C*O0  OR  R4<>0 

RT 

004345 

THEN  ER|  =  S  TR  ( CMSGl  ,141) 

RT 

004350 

OOIO  PRINT  SCREEN 

RT 

004355 

RT 

004360 

MESS: 

ERt="  File  "&PFILEI&"  in  Liurary  "i»  SLIBl  4"  on  *  & 

RT 

004365 

SVOLI 

generated.*:  E|=HEX[84) 

RT 

004370 

GOIO  PRINT  SCREEN 

RT 

004375 

RT 

004380  TTL  PGE: 

RT 

004385 

WRITE  »3,  USING  TIT,  HEX(8UU1) 

RT 

004390 

WRITS  # 3 ,  USING  TIT,  HEX(0015) 

RT 

004395 

Cl  =  HEX(0001) 

RT 

004400 

WRITE  #3,  USING  TITI,  Cl 

RT 

004405 

WRITE  #3,  USING  TIT2,  C| 

RT 

004410 

WRITE  #3,  USING  TITO,  C$,Dt,T$ 

RT 

004415 

WRITE  #3,  USING  TIT3,  Cl 

RT 

004420 

WRITE  #3,  USING  TIT2,  Cl 

RT 

004425 

WRITE  #3,  USING  TITI,  Cl 

RT 

004430 

WRITE  *3,  USING  TIT2,  Cl 

RT 

004435 

IF  SUdll  =  "  "  THEN  GERRI 

RT 

004440 

WRITE  *3,  USING  TIT4,  Cl,  SU81I 

RT 

004445 

IF  SUB2IO"  “  THEN  WRITE  #3,  USING  TIT10, C|,SUB2I 

RT 

004450 

WRITE  #3,  USING  T1T2,  Cl 

RT 

004455 

GRRRV: 

WRITE  |3,  USING  TIT5,  C|,DPIL$ 

RT 

004460 

WRITE  #3,  USING  TIT2,  Cl 

RT 

004465 

WRITE  |3,  USING  TITb,  C$,DLIB| 

RT 

004470 

WRITE  »3,  USING  TIT2,  C| 

RT 

004475 

WRITE  #3,  USING  T1T7,  Cl,DVOLt 

RT 

004480 

WRITE  |3,  USING  TIT2,  Cl 

RT 

004485 

WRITE  *3,  USING.  TITI,  Cl 

RT 

004490 

RETURN 

RT 

004495 

RT 

004500 

HEADER 

RT 

004505 

PAG£fc=PAG£%  t 1 

RT 

004510 

IP  OPTIONS  Oil  OPTIONAL#  THEN  PtlSTl 

RT 
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004515  WRITE  #3,  USING  TIT,  C$  RT 

004520  WRITE  #3,  USING  IMG8,  C£  RT 

004525  GOTO  FIRST  RT 

004530  r'RSTl:  WRITE  13,  USING  ROT,  C$  RT 

004535  WRITE  #3,  USING  ROTi,  HEX! 0000)  RT 

004540  WRITE  #3,  USING  ROTI,  HEX! 0000)  RT 

004545  FIRST:  WRITE  #3,  USING  TIT,  HEX(8001)  RT 

004550  IF  SUSlt  =  *  *  1  RT 

004555  THEN  WRI  TE  <3,  USING  IMG, C$,Dfc,  Tt,PAGEt  !  RT 

004560  ELSE  GOTO  POUT  RT 

004565  GOIO  WRITE  RT 

004570  POUT:  WRITE  #3,  USING  IMG1,C$,SUB1$ , Dt , T$, PAGE*  RT 

004575  IF  SUB2$<>"  *  \  RT 

004580  THEN  WRITE  #3,  USING  IMG7,C£ ,SUB2$  RT 

004585  ALRITE :  WRITE  *3,  USING  IMG2,  C$,  DFIL$,  DLIB6,  DVOLfc  RT 

004590  WRITE  #3,  USING  IMG3,  C$  RT 

004595  WRITE  #3,  USING  IMG4,  C$  RT 

004600  WRITE  #3,  USING  IMG5,  C$  RT 

004605  WRITE  |3,  USING  IMG3,  CS  RT 

004610  RE'KJRN  RT 

004615  RT 

004620  TIT0:%l#  ##•#»»•#  t  RT 

UU4625  #»»»»  !  RT 

004630  TIT:  *1#  RT 

004635  DG:%»»  ! '. END  OF  LISTING  “i  RT 

004640  TIT1 :  *##  ! - - - .’  RT 

004645  - 1  RT 

004650  TIT2 : % # #  !  1  RT 

004655  :  RT 

004660  ITT3:%I#  1  ******  ,<OOT  WORD  EXPANSION  ****!  RT 

004665  *  i  RT 

U04670  TIT4:%##  1  TITLE  OF  LIST:  mil MIIIDIMi:  RT 

004675  #»##  l  RT 

004680  riT5:%»l  *.  ,  EXPANSION  FILE:  t#tlll«#  RT 

004685  I  RT 

004690  TIT6 :  % # #  1  EXPANSION  LIBRARY :  #**#####  RT 

004695  '.  RT 

004700  TIT7:i»#  '.  EXPANSION  VOLUME:  ######  I  RT 

004705  '.  RT 

0047 1U  T1T1U: 41#  1  >#»#»l#l>#«m#:  RT 

004715  #»>#}  l  RT 

004720  IMG: 41#  #>####»#  ##«##  1  RT 

004725  PAGE  #»##»  RT 

004730  IMG1:4##  TITLE  OF  LIST  :  #»»»l#»lt»###|»»#|»#  »>>##»»»  \  RT 

004735  ####>  PAGE  ttm  RT 

004740  IMG7 :%##  ####»##»#### »*###»##  RT 

004745  IMG2:%#»  Input  File  is  ##»#»###  in  Liorar/  ###>##«#  on  Volume  #11!  RT 

004750  ###  RT 

004755  IMG3 : %  ##=========================================================;  RT 

004760  ====================  RT 

004765  IMG4:%#»  WORD  Part  of  Past  To  Be  Nel  RT 

004770  gative  Mand  Tech  RT 

004775  IMG5:%##  Speech  Participle  !  RT 

00473U  Word  RT 

004785  IMG6:%#|  #  HI##*#*##*#########  «#<»######  #  #  1  RT 

004790  »  #  RT 

0.14795  IMG9:4#<  1 1 »  #  »  »#  »#  I  #  » t  Ml#  I  #  #  RT 
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004800  IMG8:*##  l  -  ROOT  WORD  AT 
004805  ROT: % II  BOLDFACE  =  Root  Word  Rf 
004810  AOTi:%|»  BOLDFACE  RT 
004815  RT 
004820  MERGE:  PLAG =0  RT 
004825  DISPLAY  !  RT 
004830  AT  (01,03),  1  RT 
004835  "CRES:  Expanded  Root  Word  Merge  Suosystem",  !  RT 
004840  AT  (01,61),  !  RT 
004845  "(Generation  Screen)",  \  RT 
004850  AT  (02,03),  *.  RT 
004855  "=»=================— ======«==========================a=======>==<==;  RT 

004860  =-===========* ,  !  RT 

004865  AT  (12,23),  !  RT 
004870  "Merging  is  now  taking  place! "  RT 
004875  IP  OPEN*( 2) =1  THEN  CLOSE  |2  RT 
004880  OPEN  NOGETPARM  12,  10,  FIL£=DFIL$,  LIBRAAY=DLIB$,  VOLUME=*DVOL$  RT 
004885  OPEN*( 2) =1  RT 
004890  READ  f  2, 10l3UFF$,B0D  GOTO  4940  RT 
004895  READ  #1/ HOLD,  K£7=STR(  lOdUr'Fi, ,  20) , BUFFS,  BOD  GOTO  INSERT  RT 
004900  REWRITE  |1,  IOdUFF$  RT 
004905  GOTO  4890  RT 
004910  INSERT:  RT 
004915  WRITE  #1,  IOtJUPPS  RT 
004920  GOTO  4890  RT 
004925  RT 
004926  SCRA  TCH_P 1 LE :  RT 
004930  ERf»  "Before  returning  to  the  Master  Menu,  consider  the  following!  RT 
004935  deletion."  :GOTO  4945  RT 
004940  FIAG=0:  ER$="  Merge  lias  oeen  sucessfuliy  conpieted!"  RT 
004945  E$=HEX( 84)  RT 
004955  ACCEPT  !  RT 
004960  AT  (01,03),  !  RT 
004965  "CRES:  Root  Word  Expansion  Subsystem  (Merge  Conpl!  RT 
004970  etion  Screen)",  !  RT 
004975  AT  (02,03),  !  RT 
004980  "==============================================================—!  RT 

004985  ^============",  !  RT 

004990  AT  (05,04),  FAC(E$),  ERf,  C H(70),  !  RT 
004995  AT  (08,04),  !  RT 
005000  "Press",  !  RT 
005005  AT  (08,10),  FAC(  HEX(  84) ) ,  PP2I  ,  CH(03),  !  RT 
005010  AT  (08,14),  !  RT 
005015  ",  if  you  want  to  delete  the  work  file  consisting  of  the  root  wor!  JM 
005020  d",  !  RT 
005025  AT  (09,04),  !  rt 
005030  "list  you  have  just  created.  If",  !  RT 
005035  AT  (09,36),  FAC(HEX(84) ) ,  DFIbt  ,  CH(0b),  !  RT 
005040  AT  (09,43),  !  RT 
005045  "is  not  deleted  from",  !  rt 
005050  AT  (09,63),  FAC l  HEX(  85) ) ,  DVOLt  ,  CH(U6),  !  RT 
005055  AT  (09,70),  !  RT 
005060  ",  t ban" ,  !  RT 
005065  AT  (10,04),  !  RT 
005070  “the  system  utility  'DISPlAf  rtay  oe  used  at  a  later  date  to  view!  RT 
0050/5  this  list",  !  RT 
005080  AT  (11,04),  !  RT 
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005085  'again.  However,  it  is  advised  to  delete  these  riles  when  possio 
005090  le  to  avoid*, 

005095  AT  (12,04), 

005100  “unnecessary  accumulation  of  expanded  root  word  files  on  disk.', 
005101  AT  (16,15),  FAC ( E 1$ ) ,  ERlS, 

005105  AT  (22,17), 

005110  "Press’, 

005115  AT  (22,23),  FAC( HEX( 84) ) ,  PF15$  ,  CH(04), 

005120  AT  (22,28), 

005125  'to  return  to  the  file  selection  screen', 

005130  AT  (23,22), 

005135  "Press', 

005140  AT  (23,28),  PAC(HEX(84) ),  PF16$  ,  01(04), 

005145  AT  (23,33), 

005150  "to  return  to  the  Master  Menu', 

005155  KEYS( BIN( 2)  SHIN ( I8)&SIN( 15)iBIN( 31)&BIN(  16)&BIN( 32) ) , 

005160  ON  ( BIN( 2) &BIN( 18) &BIN( 16) 6BIN( 32) )  QOTO  SCRAT, SCRAT, EXI T, EXIT 
005165 

005170  ER$="  ':  E|!=HEX(  80  :  PILE$='  *:G0TO  FrLMNU 
005175  ' 

005180  SCRAT:  IF  0PEN%(2)-1  THEN  CLOSE  #2:OPEN%( 2) »0 
005185  CALL  'LIMITS'  (DFIL$,DLIB$,OVOLf , CODES) 

005L90  IF  OODEt="Y'  THEN  5205 

005195  £Rl$='No  work  file  was  created  on  this  run' 

005200  E1$=HEX( 84) :  ER$=*  ':  B$=HEX(8C):  GOTO  4955 

005205  CALL  'SCRATCH'  ADQR('P',DPIL$,DLIB$,D\XX4,  "S'  ) 

005210  ERlf=  DFILfiS,'  in  "&DLIB$&*  on  '&DTOL$&*  las  been  deleted.' 

005215  E1$=HEX(84)  :ERt=*  ’:E$=H£X(8C) 

005220  GOTO  4955 

005225 

005230  EXIT:  IF  OPEN%(l)=l  THEN  CLOSE  #1:  IF  OPEN%(2)=l  THEN  CLOSE  #2 

005235  IF  OPEN%(3)»l  THEN  CLOSE  #3  :  END 

005240 

005245  /*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  V 
005250  /*  SETS  OP  FLASHING  FACS  IN  APPROPRIATE  PLACES  */ 

005255  DEF  FN *  7 (  ERi> ,  St ,  Cl> ,  D6 ) 

005260  PRINT 

005265  E$=HEX[ 94) 

005270  F$=B$ 

005275  L$=Ct 

005280  Vfc=Dt) 

005285  RE'TURN 
005290 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 


RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 
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CRES  ANALYSIS  SUBSYSTEM 

User  Default  Set-Up  (KIKOFF) 

KIKOFF  in  library  CRESOSRC  is  the  BASIC  language  program  to  set  up  and 
supply  default  values  to  the  CRES  Analysis  program.  The  program  checks  for 
the  existence  of  a  defaults  file  for  the  particular  user.  (The  file  name  is 
formed  by  concatenating  the  user  ID  and  the  string  "DFLTS",  and  the  file  is 
stored  in  library  CREStaDAT.)  If  the  file  exists,  the  defaults  are  set 
accordingly.  If  the  file  does  not  exist,  a  flag  is  set  to  create  a  defaults 
file  for  that  user  at  the  end  of  the  analysis  run.  The  object  language 
version  is  KIKOFF  in  library  CRES@SAV. 

A  complete  program  listing  follows. 
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000010  /******************************************* *********************/ 

000030  /*  */ 

000050  /*  SUBROUTINE  KIKOFF  SETS  UP  THE  USER  DEFAULTS  FOR  THE  */ 

000070  /*  ANALYSIS.  THIS  BLOCK  CHECKS  IF  A  DEFAULT  FILE  EXISTS  FOR  */ 

000090  /*  THE  PARTICULAR  USER.  IF  THE  FILE  EXISTS,  THE  DEFAULTS  ARE  */ 

000110  /*  FETCHED  AND  USED.  IF  THE  FILE  DOES  NOT  EXIST,  THE  FILE  IS  */ 

000130  /*  CREATED  AND  DEFAULTS  ARE  SUPPLIED.  */ 

000150  /*  V 

000 170  /******************************** ********************************/ 
000190 

0002)0  SUB  "KIKOFF"  ADDR(RGL$,PREP  CNTJ,PASSV$,LNG  SENS, LNG  PARS.LNGWDSS1 
000230  ,LNGSNTJ,NEG$,UNCOM},NUM  SUBZJ.INT  ANL $,7JP$,ADVFNT,PERS_SENU,  I 
000250  LNG  CLSS,TRNK_PVJ,TECFir$( )  ,TECLIffS( )  ,TECV0L*(  )  .RETS,  INL  IBS,  1 
000252  1NV(5L$) 

000270  DIM  RGLJ1 ,PREP  CNTJ1 ,RET$1 , INV0LJ6, INLIBJ08 

000290  DIM  PASSVJ1  ,LNS_SENS1  ,LNG_PAR$1  ,LNGWDSJ3,LNGSNT$2,NEG$1  .UNCOMJI 

000310  DIM  NUM_SUBZSI , 1  NT _ ANL  J 1  ,NPJ2,ADVFNJ1  ,PERS  SENTJ1  ,LNG_CLS$1 

000330  DIM  TRNK  PV$1  ,TECFIL$(7  )08,TECLIB3(7  )08,TE?V0LS(7  )06 
000350  DIM  USERT3,FIL0$08,RETC$1 .MESGJ40 

000370  DIM  F I $10,BUFF$190,F2$32,F3$14,F4$14,BUFF1$20,BUFF2$52,BUFF3J52 
000372  DIM  BUFF4J50,F5J14,BUFF9$190 
000390  F1$=HEX(A0F40010A034A034A032 ) 

0004  60  F  2  S =HE  X ( AOO 1 AOO I AOO 1 AOO 1 AOO 1 A003 AOO  2A00 1 AOO 1 AOO 1 AOO 1 A002 AOO 1 AOO 1 A I 
000461  001 AOO 1 ) 

000465  F3 J 'HE X ( A008A008A006A008A008A006A008 ) 

0004  67  F  4  S'HE  X ( A008A006A008A008A006A008A008 ) 

0004  69  F  5  S ' HE  X ( A006A0  08 A008A006A008A008A006 ) 

0004/0  SELECT  01,  "SETDFLTS",  CONSEC,  RECSIZE  =  190,  IOERR  GOTO  PR0B1 

000490  SELECT  #2,  "GETOFLTS" ,  CONSEC,  RECSIZE=190,  IOERR  GOTO  PR0B2 

000530  CALL  "EXTRACT"  AD0R("ID",  USERS)  /*  FETCH  THE  USER'S  ID  */ 

000550  FIL0S=USERS4  "DFITS" 

000570 

000590  /*  SEE  IF  THE  DEFAULTS  FILE  EXISTS  FOR  THIS  USER  */ 

00  0  610 

000630  CALL  "L IM I TS" ( F IL0$, I NL IBJ, INVOL S.RETCS ,MESG$ ) 

000650  IF  RETC$="Y"  THEN  FETCH  , 

00067  0 

000690  /*  IF  HERE,  WE  NEEO  TO  GENERATE  A  DEFAULTS  FILE  */ 

0007  1  0  /*  WE  NEED  THE  ANALYSIS  SCREENS  TO  ASK  FOR  DEFAULTS,  */ 

000730  /*  SO  SET  RETURN  CODE  AND  GO  BACK  TO  ANALYSIS  PROGRAM  */ 

0007  50 

000770  OPEN  NOGETPARM  #1,  OUTPUT,  SPACE=1,  FILE'FILOS, LIBRARY'  I 

000790  INL  IB$,  VOLUME' INVOLS 

000810  BUFF  IS  =  RGL$  4  PREP  CNT$  &  PASSVS  4  LNG_SENS  4  LNG  PARS  41 

000830  LNGWDSS  4  LNGSNTS  4  n£GS  4  UNCOMS  4  NIM  SUBZS  4  INTjfaLS  4  ■ 

000832  NPS  4  ADVFNS  4  PERS  SENTS  4  LNG_CLSS  l  TRNK_PVS 

000842  BUFF2S  =  STR(TECFILS(T) , 1 ,8)  4  STR ( TECL  IBS ( T ) , 1 , 8 )  4  I 

000852  STR(TECV0LS(1),I,6)  4  STR(TECFILS(2) ,  1 ,8 )  4  STR ( TECL I BJ ( 2 )  ,1.8)  ! 
000862  &  STR ( TEC VOL$ ( 2 ) ,1,6)  4  STR ( TECF I L 5 ( 3 ) , 1 ,8) 

000872  BUFF3S  *  STR  (TECL  IBJ(3 ) ,  1 ,8 )  4  STR  { TEC  VOL  S  ( 3 )  ,1,6)  4  I 

000882  STR ( TECF I LS( 4 ) , 1 ,8)  4  STR ( TECL IBS( 4 ) , 1 ,8)  4  STR ( TEC VOL S ( 4 )  ,1,6)  I 
000892  4  STR ( TECF IL$(5) ,1,8)  4  STR ( TECL I BS ( 5 ) , 1 ,8) 

000902  8UFF4S  =  STR (TECVOL$ (5) ,  1 ,6)  4  STR( TECFJLS(6) ,  1 ,8)  4  I 

000912  STR ( TECL  1 8 J ( 6 ) , 1 ,8)  4  STR(TECV01J ( 6) , 1 ,6)  4  STR ( TE CF I LS ( 7 ) ,  1 ,8)  I 
0009  2  2  4  STR(  TECL  I8S(7  ) ,  1 ,8 )  4  STR ( TE C VOL S ( 7 ) ,  1 ,6) 

000932  SPACK  (F=F1$)  BUFFS  FROM  BUFFI },  BUFF 2$,  BUFF3S,  BUFF43 

000950  WRITE  XI,  BUFFS 
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00097  0 
000990 
001010 
001030 
001050 
001060 
00107  0 
001090 
001110 
00) 130 
001 132 
001134 
001136 
001138 
001140 
001 144 
001  146 
001147 
001  148 
001270 
001290 
001310 
001330 
001350 
001370 
001380 
001390 
001400 
001410 
001415 
001420 
001430 
001435 
001440 
001450 
001455 
001460 
001470 
00147  5 
001530 
001550 
001570 
001590 
001610 
001630 
001650 
00167  0 
001  690 
001710 
001730 
001750 
001770 
001790 
001810 
001830 


CLOSE  #1 

RET$="L "  /*  SO  WE’LL  LOAD  DEFAULTS  AFTER  USER  SETS  THEM  */ 

GOTO  IT  /*  RETURN  */ 


JM 


FETCH: 


IF  RET}=“L"  THEN  MISS 

OPEN  NOGETPARM  #2,  10,  F ILE  =F I LO} ,L  IBRARY  =  INLIBJ,  I 

VOLUME  =1  NVOL$ 

READ  #2,  BUFFS 

SUNPACK  { F=F1$)  BUFFS  TO  BUFF  1 S .BUFF2S, BUFF3} ,BUFF4$ 
SUNPACK  (F=F2$)  BUFF  1 S  TO  RGL},PREP  CNTJ.PASSVJ.LNG  SENS,  I 
LNG  PAR$,LNGWDS},LNGSNTS,NEG$,UNCDM},NUM_SUBZ$,INT_ANL},  : 
NP},ADVFN},PERS_SENT},LNG  CLSJ.TRNK  PVS 
SUNPACK  ( F=F3 $ )  BUFF2}  TO  TFCFIL$(I  )  ,IECLIBS(  1 )  ,TECVOL$(  1 ) ,  1 
TECF ILJ(2) , TECL IB J( 2) ,T£CVOL J (2) ,  TECF I L}( 3 ) 

JUNPACK  ( F=F4$ )  BUFF3S  TO  TECL IBS(3 ) . TE  C VOL  $ ( 3 ) , TECF  I L  $ { 4 ) ,  I 
TECL  IB} (4) , TE C VOL 5(4) ,TECFIL}(5) .TECL IB}(5) 

SUNPACK  ( F=F5 S )  BUFF4S  TO  TECV0L}(5) , TECF IL$( 6) ,TECLIBS(6) , I 
TECVOL}(6),TECFIL}(7) .TECL IB}(7 ) ,TECV0L}(7 ) 

CLOSE  42 

GOTO  IT  /*  RETURN  */ 


MISS: 


OPEN  NOGETPARM  42,  10,  F I  LE  =  FILO}, LIBRARY  =  INLIBS,  I 

V0LUME  =  I NVOL} 

BUFFI }  =  RGLS  4  PREP_CNT }  4  PASSV}  4  LNG_SEN}  4  LNG  PAR}  41 
LNGWOSS  4  LNGSNTS  4  NEGS  4  UNCOMS  4  NUM_SUBZ}  4  INT_ENL$  4  I 
NPS  4  AOVFN}  4  PERS_SENT}  4  LNG_CLSS  4  TRNK_PV} 

BUFF2}  =  STR ( TECF IL}(T) , 1 ,8)  4  STR( TECL I B$ ( 1 ) , 1 ,8)  4  I 

STR( TECVOL J( 1 ) , 1 ,6)  4  STR (TECF I L$ ( 2 ) ,1 ,8)  4  STR ( TEC L I B $ ( 2 )  ,1.8)  I 
4  STR( TECVOL} ( 2 ) , 1 , 6 )  4  STR( TECF I L} (3 ) , 1 ,8 ) 

BUFF3}  =  STR( TECL IBS( 3 ) , 1 ,8)  4  STR( TECVOLS (3 ) , 1 , 6)  4  I 

STR(TECFIL}(4) ,1,8)  4  STR (TECL IB}(4) , 1 ,8)  4  STR(TECV0L}(4) ,  1 ,6)  I 
4  STR(TECFILS(5) ,  1 ,8)  4  STR( TECL IB}( 5 )  ,1,8) 

BUFF4}  =  STR( TECVOL}( 5 ) , I , 6 )  4  STR ( TECF IL} ( 6) , 1 ,8 )  4  I 

STR ( TECL IB$(6) ,1,8)  4  STR(TECV0L}(6), 1,6)  4  STR ( TECF I L J ( 7 ) , 1 ,8)  I 
4  STR  (TECL  IB}(7 ) ,  1 ,8 )  4  STR  ( TECV0L}(7  ) ,  1 ,6) 

SPACK  ( F-F I } )  BUFF}  FROM  BUFFI},  BUFF 2},  BUFF3S,  BUFF4} 

REAO  42,  HOLD,  BUFF9} 

REWRITE  42,  BUFF} 

CLOSE  42 


PROBI 


GOTO  IT 

PRINT  AT(  23 , 1 )  . 
"  STATUS  IS 


I/O  ERROR  ON  DEFAULTS  FILE,  41.  FILE";! 
;  FS  ( 4 1 ) 


PR0B2: 


IT: 


STOP  "PRESS  ENTER  TO  CONTINUE" 

CLOSE  41 
GOTO  IT 

PRINT  AT (23, 1 ) ,  "I/O  ERROR  ON  DEFAULTS  FILE,  42" 
FILE  STATUS  IS  :  ";FS(42) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

CLOSE  42 


END 
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Document  and  Word  List  Selection  (SCRENZ) 

SCRENZ  in  library  CRES@SRC  is  the  BASIC  language  program  to  allow  user 
selection  of  the  document  to  be  analyzed  and  the  names  of  the  Common  Word 
List,  Word  Substitution  List,  and  Phrase  Substitution  List  to  be  used  by  the 
CRES  Analysis  program.  Default  values  are  supplied,  and  may  be  changed  by  the 
user  if  desired.  The  program  verifies  that  the  document  and  lists  selected 
actually  exist.  The  object  language  version  is  SCRENZ  in  library  CkES(s>SAV. 

A  complete  program  listing  follows. 
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000010  SUB  "SCRENZ"  (Ca4FIL$  ,O>lLIB$,00MV0L$,WRDFIL$,WRDLI3$,WRD\A>L$, 
000020  PHRPIL5,PHRLIB$,PHRVOL$,DOCFIL$/DOCLIB$,DCVOL$,PAG_riTL$,  *. 

000030  LIB$,REG%, INLIB$, INVOL$) 

000040 

000050  SELECr  # 1 , " CMNWDLST"  , VARC,  INDEXED, RECSIZE=40, 

000060  KEYPOS=01,,  KEYL£N=20,  TOERR  GOTO  IO_ERRl 

000070  SELECT  #2,  "WRDS8LST" , VARC,  INDEXED, RECSIZB=80,  \ 

000080  KEYPOS=01,  KEYLEN=20,  IOERR  GOOD  IO_£RR2 

000090  SELECT  #3,  "PHRSBLST* ,  VARC,  INDEXED, RECSIZE=70,  ! 

000100  KEYPOS=01,  KEYLEN=20,  IOERR  GOTO  IO_ERR3 

000120  DIM  WRDFIL$8,WRDLIB$8,WRDVOLS6,FG$l  6)  01,LI3$1 

000130  DIM  PHRFILS8 ,  PRRLIB$8 ,  PHR'A3L$6 

000140  DIM  COMFIL$8,CDMLIB$8,OOMVOL$6,OP£N%(3) 

000150  DIM  AY$2,E$65,FERil,A$8,B$16,C$24,D$22,BUFF$50 
000151  E$="  * 

000160  ENTER$- *  ENTER “ 

000170  PF$="PF16" 

000171  MAT  OPEN%  =  ZER 
000180  COMEILf="CMNWDLST" 

000190  PllRFIL$=*  PHRSBLST" 

000200  WROFIL$="WROSBLST" 

000220  DOCLIB$=*  * 

000230  *  C0MLI8$,  PiIRLIB$ ,  WR0LI8$=’CRES@UAT" 

000240  *  COMVOL$,PlIRVOL$,WRD\A)L$="FIXVOL* 

000250  FG*(  )=ALL(HEX( 81) )  :FG$( 4) =HEX( 82)  :FG$( 5) =HEX( 80) 

000260  FER$=H3X(  80 
0U0270  A$="Oocument" 

000280  B$="Common  Word  List” 

000290  C$=“Phrase  Suostitution  List* 

000300  D$="Word  Substitution  List" 

000310  SCREEN1: 

000315  ACCEPT  1 

000320  AT  (01,03),  1 

000330  "CRES:  Document  Analysis  Subsystem  (Document  &  Word  Lists  Selel 
000340  ction  Screen)",  I 

000350  AT  (02,03),  I 

000360  "========^================================================  =  =  *■===  =  : 

0U037O  =============", 

000380  AT  (04,10), 

000390  "Welcome  to  the  Document  Analysis  Option.  Please  identify  the", 
000400  AT  (05,10),  : 

000410  "document  to  be  analyzed  and  identify  the  Common  Word  List,", 

000420  AT  ( Oo, 10) ,  I 

000430  “Phrase  Substitution  List,  and  the  Word  Substitution  List  ",  1 

000440  AT  (07,10),  I 

U00450  "to  be  used,  it  the  defaults  are  not  satisfactory.  If  desired,",1. 
000460  AT  (08,10),  ! 

000470  "input  a  title  to  be  printed  on  each  page.",  1 

000430  AT  (10,10) ,FAC( rfEX( 8C) ) ,  ! 

000490  A$, 

000500  AT  (10,19),  J 

000510  AT  (11,12),  I 

000520  "FILE  :",  ! 

000530  AT  (11,20),  FAC( FG$ ( 04 ) ) ,  DOCFIL$  ,  CH(04),  ( 

000540  AT  (11,32),  i 

000550  "LIBRARY  :",  I 

000560  AT  (11,43),  FAC( FG$( U5) ) ,  LIBS  ,  Cri(01),  I 


JM 

JM 


JM 

JM 


JM 

JM 
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000570 

AT  (11,55), 

000580 

"VOLUME 

000590 

AT  (11,65), 

F  AC  ( FG$  (06)),  DC\A)U 

,  CH( 06) , 

000600 

AT  (13,10), 

FAC(riEX(8C) ) , 

000610 

B$,  AT  (13,27),":" 

/ 

000620 

AT  (14,12), 

000630 

"FILE  :", 

000640 

AT  (14,20), 

FAC( FG$( 01 ) ) ,  COMFIL$ 

,  Cri( 03) , 

000650 

AT  (14,32), 

000660 

"LIBRARY 

000670 

AT  (14,43), 

F AC ( FG$ ( 0 1 ) ) ,  COMLI8$ 

,  CH( 08), 

000680 

AT  (14,55), 

000690 

"VOLUME  :", 

000700 

AT  (14,65), 

FAC( FG$( 01 ) ) ,  COMVOL$ 

,  C8( 06) , 

000710 

AT  (15,10), 

FAC(8EX(8C)), 

000720 

C$,  AT( 15,35) ,  ":" 

/ 

000730 

AT  (16,12), 

000740 

"FILE 

000"’50 

AT  (  16,20), 

FAC( FG$£ 02) ) ,  PHRFIfJ 

,  CH( 08) 

000760 

AT  { 16,32) , 

000770 

"LIBRARY  :", 

000780 

AT  (16,43), 

F AC ( FG$ ( 0 2 ) ) ,  PriRLIdS 

,  CH(08) 

000790 

AT  (16,55), 

000800 

"VOLUME  :", 

000810 

AT  (16,65), 

FAC( FG$( 02) ) ,  PrfRVOLS 

,  CH( 06) 

000820 

AT  (17,10), 

FAC ( HEX ( 8C) ) , 

000830 

D$,  AT( 17,33),  ":" 

t 

000840 

AT  (18,12), 

000850 

'FILE  :", 

000860 

AT  (18,20), 

FAC( FG$( 03) ) ,  WRDF I L$ 

,  Cri( 08) 

000870 

AT  (18,32), 

000880 

"LIBRARY 

000890 

AT  (18,43), 

FAC(  FG£(  03) ) ,  NRDUdS 

,  Cri( 08) 

000900 

AT  (18,55), 

000910 

"VOLUME  :", 

000920 

AT  (18,65), 

FAC(FG$(03) ) ,  WKDVOU 

,  CH( 06) 

000930 

AT  (20,10), 

000940 

"Title:", 

000950 

AT  (21,11), 

PAGTITU  ,  CH(  60) , 

000960 

AT  (22,04), 

000965 

FAC(FHR$), 

E$  ,  CH( 65) , 

000970 

AT  (23,28), 

000980 

"Press" , 

000990 

AT  (23,34), 

FAC( HEX (84)),  ENTERS, 

001000 

AT  (23,40), 

001010 

"to  continue* , 

001020 

AT  (24,18), 

"Press", 

001030 

AT  (24,24), 

FAC( HEX( 84 ) ) ,  PF$, 

001040 

AT  (24,29), 

00LQ50 

"to  return  to  the 

CUES  Master  Menu", 

001060 

KE7S(  tlEX(  001020 )  )  , 

KEY (RE*) , 

0U107U 

ON  (BIN( 16) &3IN( 32) )  GOTO  GONE, GONE 

001030 

001081 

E$»"  "  :FER$= 

HEX(  80 

001090 

FLAG 4  -=  0  :  BOCLIBS^" 

00 1100 

001110 

/*  Scifci  Ir  cl LituS  cXloT  IViAi’  i'dfcJ  USfclr?  INiAJT 

Page 


* 
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001120 

001130 

001140 

001150 

001160 

001170 

001180 

001190 

001200 

001210 

001220 

001230 

001240 

001250 

001260 

001270 

001280 

001290 

001300 

001310 

001320 

001330 

001340 

001350 

001360 

001370 

001380 

001390 

001400 

001410 

001420 

001430 

001440 

001450 

001460 

001470 

001480 

001490 

001500 

001510 

001520 

001530 

001540 

001550 

001560 

001570 

001580 

001590 

001600 

001610 

001620 

001630 

001640 

001650 

001660 

001670 

001680 


IP  LIB$  >  *2*  THEN  DOCLIB$  =  "DOCMNT*  &  L 18$  &  LI3$  I 

ELSE  DOCLISf  =  "DOCMNT*  &  LIB$ 

TRAN  (DOCLI8$,  ! 

"AaBbCcDdEeFfGgHhliJ  jKkLlMntinOoPpQcjlrSsTtUuVvWwXxYyZz* )  REPLACING 

CALL  "LIMITS" (DOCFIL$, DOCLIB$,DCVOL$, RC$, MS  Gt) 

IP  RC$  *  *Y*  THEN  LP 

FG£( 4) =HEX( 92)  :  FG$(  5)=HEX{90)  :  FGf( 6) =HEX( 91 ) 

GOTO  SCREEN 1 

LP:  IP  C0MFIL£=’CMNWDLST"  AND  COMLI3£=INLI3$  AND  COMVOLt=  JM 

INVOL$  THEN  NI  JM 

IP  OOMFIL$=*  "  OR  00MLI8$="  "  OR  OOMVOL$="  "  THEN  NIS 

FLAG%  =  1 

CALL  "LIMITS"  (COMFIL$,OOMLIB$,OOMVOL$,RC$,M3G$) 

IF  RC$=" Y"  THEN  NI 

NIS:  FG£{ ) =ALL( HEX( 81) )  :FG$ ( 4) =HEX( 82)  : FGt ( 5)=HEX(  80) 

PER$=HEX( 94 ) 

Ei=<"Co(nnon  Word  List  "&  STR( COMPILE, 1,8)  &*  in  "  &  1 

STR(OOMLIfl$,l,8)  &  *  on  "&  STR ( COMVOLS ,1,6)  6 
"  does  not  exist." 

COMFIL$=*CMNWDLST"  :COMLIB£=INLlB$  :OOMVOl£=INVOL$  JM 

PLAG%=0 

GOTO  SCREEN 1 

NI:  IP  PHRF I L$= “ PHRS3LST"  AND  PHRLI8$=INLI3$  AID  PHRVOL$=  INVOL$  I  JM 
THEN  NI2  JM 

IP  PHRPIL$="  "  OR  tMRLI8$=*  "  OR  PHRVOL$=*  ’  THEN  NIS2 
FLAG%  =  PLAG%-*-2 

CALL  "LIMITS " ( PHRFILH, PHRLIBU, PHRVOLt , RC$ , MSG$ ) 

IP  RC$="Y"  THEN  NI2 

NIS2:  PG$( )=ALL(HEX(81) )  :FG$( 4)=HEX( 82)  :PG$( 5)=HEX(80) 

FF.R$=HEX(  94 ) 

E$="P)u:ase  Suo.  List  "&  STR{PHRPIL$,1,8)  &  ’  in  "&  I 

STR(PHRLIB£,1,8)  6.  "  on  "6  STR(PHRVOL$,l,6)  S.  I 

"  does  not  exist." 

PHRF  I L$="  PILRS3LS  T"  : PHRLI3$=INLIB$  :  PHRVOL$=INVOL$  JM 

PLAG%=0 

GOTO  SCREEN1 

NI2:  IF  WRDF I L£= " WilDSB LS  T“  AND  WRDLI8$=INLI3£  AND  WRDVOLt=INVOL$  I  JM 
THEN  NI3  JM 

IF  WRDFIL$="  "  OR  WRDLI8$="  "  OR  WRDVOL$="  *  THEN  NIS3 
P  LAG% =FLAG% + 4 

CALL  "LIMITS" (WKDFIL$,WRDLIB$,WRDVOL$,RC$,MSG$) 

IF  RC$="Y"  THEN  NI3 

NIS3 :  FG$( )  =ALLl  HEX(  81 ) )  :FG$( 4) =HEX( 82)  : FG|( 5) =HEX( 80) 

F£R$=HEX[ 94 ) 

E$="Word  Sud.  List  "&  STR(WRDFIL$,i,8)  6"  in  "  &  : 

STR(WRDLIB$,1,8)  &  ’  on  "  5.  S TR ( WRDVOL$ ,1,6)  6  [ 

“  does  not  exist."  JM 

WRDPIL$="WRDS8LST"  :WRDHB$=INLId£  :WRDVOL£=  INVOLS  JM 
FLAG%=0 
GOTO  SCREEN! 

NI3:  /*  IP  WE  OJME  HERE,  WE  KNOvi  THE  THREE  PILES  EXIST.  */  JM 

/*  BUT  ARE  THEY  THE  KINDS  OF  FILES  WE  THINK  THEY  ARE?  */ 
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001690 

001700  CALL  "READPDR"  ADDR(CDMFIU,CQMLIB$,CDMVOL$,0%,  *RS*  ,R£C%,RET*) 
001710  IP  REC%<>40  THEN  ER1 

001711  OPEN%( 1 ) =1 

001720  OPEN  NOGETPARM  #1,  SHARED,  FILE=COMFIL$,  J 

001730  LI3RAR7=OOMLIi3$,  VDLUME=COMVOLS 

001740  READ  §1,  BUFFS 

001750  IF  3TR( BUFFS,  1,13)="  COMMON  WORDS"  THEN  TRy 

001760  ER1 :E$="Pile  "4S'TR(COMFILS,i,8)  4  *  in  "4STR( O0MLIBS,l,8) 4"  on  *4  JM 
001770  STR(COMVOL$,l,6)  4  "  is  not  a  Comiron  Word  List." 

001780  COMFILS="CMNWDLST"  :C0MLI3$  =  INLIBS  :COMVOLS  =  INVOLS  JM 

001790  FER$=HEX( 94) 

001800  IF  OPEN%( 1 ) =1  THEN  CLOSE  #1 
001801  OPENt( 1 ) =0 

001810  GOTO  SCREEN1 

001820 

001830  TRy : CALL  "READPDR"  ADDR( WRDFILS,WRDLIBS,WRDVOLS,0%, "RS" ,REC%,R£T%) 
001840  IP  REC4O80  THEN  ER2 

001841  OPEN%( 2) =1 

001850  OPEN  NOGETPARM  |2,  SHARED,  F I LE-WRDF I LS ,  • 

001860  LIDRARy=WRDLIQ$,  VOLUME=WRDVOL$ 

001870  READ  #2,  BUFFS 

001880  IF  STR( BUFFS, 1,18)=“  WORD  SUBSTITUTION"  THEN  AGN 

001890  ER2:E$=’File  "43TR(WRDFIL$, L, 3) 4"  in  *4STR(WRDLI3$, 1,8) 4"  on  "  4  :  JM 
001900  STR(WRDVOL$,l,6)  4  "  is  not  a  Word  Sub.  List."  JM 

001910  WRDFIL$="WRDS8LST"  :WRDLIB$=  INLIBS  :WRDVOL$=  INVOLS  JM 

001920  FER$=HEX( 94) 

001921  IF  OPEN'4(i)  =  i  THEN  CLOSE  #1 

001926  IF  OPEN%( 2) =1  THEN  CLOSE  #2 

001930  MAT  OPEN%  =  2ER 

001940  GOTO  SCREEN1 

001950 

001960  AGN : CALL  "READFDR"  ADDR( PHRFILS, PHRLIB$,PHRVOL$, 0*, "RS" ,RSC*,RST% ) 
001970  IP  REC4O70  THEN  ER3 

001971  OPEN%( 3) =1 

00L980  OPEN  NOGETPARM  #3,  SHARED,  FILE=Pl[RFIL$,  I 

001990  LI3RARy=PHRLIB$,  VOLUME=PHRTOL$ 

002000  READ  #3,  BUFFS 

002010  IP  STR( BUFFS, 1,20)="  PHRASE  SUBSTITUTION"  THEN  AGANi 

002020  ER3:E$=“File  "4STR( PHRFILS, 1,8)4"  in  "4  STR( PHRLIBS , 1 ,3)  4"  on  "41  JM 
002030  3TR(PHRVULS,i,6)  4  "  is  not  a  Pnrase  Sub.  List."  JM 

002040  PHRFILS="PriRSBLST"  :PHRLI8S=  INLIBS  :PHRVOLS=  INVOLS  JM 

002050  FERS=HEX( 94) 

002051  FOR  J*=i  TO  3 

002061  IF  OPENt( Jt)=l  THEN  CLOSE  #J%  :NEXT  Ji 

002062  MAT  OPEN*  =  ZER 

002070  GOTO  SCREEN1 

002080  AGANI:  CLOSE  11  :CLOSE|2  :CLOSE|3 

002090  GOTO  GONE 

002100  IO_ERRi:  PRINT  AT(  23,1),  "I/O  ERROR  ON  COMMON  ,*DRD  LIST  FILE,  11": 
002110  ;".  FILE  STATUS  IS  :  *;FS(»1) 

002120  STOP  "PRESS  ENTER  TO  CONTINUE" 

002130  CLOSE  II  : CLOSE  12  :CLJSE  #3  :  GOTO  SCREEN  1 

002140 

002150  IO  ERR2 :  PRINT  A  T<  2  3 , 1 ) ,  "I/O  ERROR  ON  WORD  JUU3T.  LIST  FILE,  12": 
002160  FILE  STATUS  IS  :  FS(!2) 

002170  STOP  "PRESS  ENTER  TO  CONTINUE" 
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002180  CLOSE  #1  :  CLOSE  #2  :CLOSE  #3  :GOTO  SCREEN1 

002190 

002200  IO_ERR3:  PRINT  AT(23,1),  "I/O  ERROR  ON  PHRASE  SUBST.  LIST  FILE 
002210  ’  |3.  FILE  STATUS  IS  :  *;FS(#3) 

002220  STOP  "PRESS  ENTER  TO  CONTINUE" 

002230  CLOSE  #1  :CIOSE  #2  :CLOSE  #3  :GOTO  SCREEN 1 

002240  GONE:  IF  RE*=16  OR  RE%=32  THEN  REG%=0  ELSE  REG*=1 
002250  END 
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Document  Analysis  (ANALYSIS) 

ANALYSIS  in  library  CRES0SRC  is  the  BASIC  language  program  which  perforins 
the  CRES  analysis  of  a  specified  document.  The  object  language  version  is 
ANALYSIS  in  library  CRES@SAV.  The  analysis  program  is  by  far  the  most  complex 
program  in  the  CRES  system,  and  it  will  be  discussed  in  detail  below. 

At  the  start  of  the  analysis  proqram,  it  is  necessary  to  initialize 
variables,  set  defaults,  initialize  he  volumes  and  libraries  and  set  up  User 
File  Blocks  for  each  file  to  be  used.  Variables  are  initialized  by  specific 
assignments  at  the  beginning  of  the  program  and  by  the  internal  subroutine 
INIT.  Defaults  are  set  by  calling  the  external  subroutine  KIKOFF,  which 
checks  for  the  existence  of  a  defaults  file  for  the  particular  user.  (See 
discussion  of  KIKOFF  for  details.)  Volume  and  library  variables  are 
initialized  using  "EXTRACT",  a  Wang  system  utility.  User  File  Blocks  are 
established  using  BASIC  "SELECT"  commands. 

The  program  next  provides  three  screens,  which  are  utilized  to  specify  the 
document  to  be  analyzed  and  the  options  to  be  employed  in  the  analysis. 

The  first  screen  accepts  the  name  of  the  document  to  be  analyzed,  and 
displays  the  default  values  for  the  Common  Word  List,  the  Word  Substitute  List 
and  the  Phrase  Substitute  List.  Any  of  these  defaults  may  be  changed,  and  all 
file  names  are  tested  by  the  program  to  verify  that  they  exist  and  are  of  the 
correct  type. 

The  second  screen  accepts  up  to  seven  technical  word  lists  to  be  used  in 
the  analysis,  and  these  file  names  are  verified  to  ensure  data  integrity. 

The  third  screen  presents  all  the  possible  options  for  a  CRES  analysis  and 
presents  default  values.  These  defaults  are  the  ones  established  for  each 
user  by  the  external  subroutine  KIKOFF  the  first  time  an  analysis  is  run  under 
that  user  ID.  Any  combination  of  the  possible  options  may  be  selected.  The 
options  available  to  the  user  are: 

•  Report  the  Reading  Grade  Level  of  tne  document. 

•  Count  the  prepositions  and  flag  sentences  with  "too 
many"  prepositions.  (If  there  are  more  than  2 
prepositions  in  the  sentence,  and  the  ratio  of  total 
words  in  the  sentence  to  prepositions  is  less  than  5.4, 
the  sentence  is  defined  as  containing  "too  many" 
prepositions. ) 
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•  Flag  passive  voice.  (A  form  of  the  verb  "to  be", 
followed  by  a  past  participle  and  immediately  followed 
or  preceded  by  the  word  "by",  is  defined  as  the  full 
passive  voice  construction  and  flagged  as  such.) 

•  Flag  long  sentences.  (If  there  are  more  than  2.Z  words 
in  the  sentence  it  is  considered  a  long  sentence.) 

•  Flag  long  paragraphs.  (If  long  paragraphs  are  to  be 
flagged,  the  user  has  the  option  of  specifying  the 
maximum  number  of  words  and  the  maximum  number  of 
sentences  to  be  allowed  before  the  paragraph  is  flagged 
as  long.  The  default  values  are  200  words  or  10 
sentences.  The  paragraph  will  be  flagged  after  either 
maximum  is  encountered.) 

•  Flag  double  negatives. 

•  Flag  and  list  uncommon  words. 

Include  substitutes.  (If  a  substitute  for  a  word  or 
phrase  appears  on  either  the  Word  or  Phrase 
Substitution  List,  the  listed  substitute( s)  will  be 
printed  in  brackets  immediately  following  the  given 
word  or  phrase. ) 

•  Interim  analyses.  (If  a  lengthy  text  is  to  be 
analyzed,  it  may  be  desirable  to  perform  interim 
analyses.  A  final,  overall  analysis  will  still  be 
printed  at  the  end  of  the  report.  The  user  can  specify 
the  number  of  pages  between  interim  analyses.  The 
default  value  is  five  pages.) 

•  Check  personal  sentences.  (All  sentences  containing 
the  words  "you",  "your",  "I",  "we",  "my",  or  "our"  are 
defined  as  personal  sentences.  At  the  end  of  the 
analysis  printout,  the  total  percentage  of  personal 
sentences  contained  in  the  text  will  be  printed  out.) 

•  Flag  truncated  passive  voice.  (Any  form  of  the  verb 
"to  be",  followed  by  a  past  participle,  forms  the 
truncated  passive  voice  arid  will  be  flagged  as  such.) 

In  addition  to  these  options,  an  automatic  provision  is  made  for  flagging 
possible  lists  since  they  are  considered  highly  undesirable  in  certain 
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technical  writing  applications.  Whenever  the  phrase  "consist(s)  of"  appears 
in  a  long  sentence,  followed  by  three  or  more  commas,  the  query  "LIST?"  will 
be  printed  in  the  analysis. 

After  the  user  has  entered  the  desired  values  on  the  third  screen,  tests 
are  performed  to  ensure  only  logically  correct  selections  have  been  made. 

Once  all  selections  are  ascertained  to  be  valid,  if  a  default  file  does  not 
already  exist,  the  program  calls  KIKOFF  to  store  the  current  selections  as  the 
default  values  for  that  user.  All  technical  word  list  names,  as  well  as  the 
analysis  options  specified,  are  inserted  into  this  file.  The  default  file 
name  is  formed  by  concatenating  the  user  ID  and  the  string  "DFLTS",  and  it  is 
stored  in  library  CRESODAT.  The  original  defaults  may  be  changed  for  any 
given  analysis;  however,  the  default  file  will  remain  unchanged  and  subsequent 
analyses  will  have  the  original  defaults  presented.  To  change  the  default 
file  permanently,  the  user  should  scratch  the  existing  default  file  through 
the  "MANAGE  FILES/LIBRARIES"  capabilit  '  of  the  Command  Processor.  Then,  a  new 
defaults  file  will  be  generated  on  the  next  analysis  run  using  that  user  ID. 

The  analysis  program  must  open  each  specified  file.  An  output  file, 
ANALYSE,  is  created  and  opened.  The  first  analysis  run  will  be  ANALYSOO,  and 
subsequent  runs  will  be  numbered  consecutively.  A  header  is  generated  for 
this  file  which  includes  information  on  all  files  and  options  which  have  been 
selected.  All  variables  for  the  analysis  are  initialized  by  the  internal 
subroutine  SETUP. 

The  text  analysis  proceeds  word  by  word.  The  program  uses  the  Wang  VS 
word  processing  subroutines  to  access  each  word.  If  an  End  of  File  (EOF)  is 
encountered,  the  current  output  line  is  ended  and  added  to  the  output  file. 
Final  analysis  results  and  an  Uncommon  Word  List  are  also  added,  if  those 
options  were  selected.  If  an  EOF  is  not  found,  then  the  program  calls  tne 
internal  subroutine  SPUNK.  SPUNK  strips  leading  and  trailing  punctuation  or 
invalid  characters  from  around  the  word.  The  internal  subroutine  SYLLY  is 
then  called  to  calculate  the  syllable  count  for  this  word.  The  syllables  of 
the  word  are  counted,  using  a  number  of  both  general  and  specific  algorithms. 

The  syllable  count  is  obtained  by  starting  with  the  general  rule  that 
there  is  one  syllable  per  vowel.  Specific  exceptions  are  made  for  the  case  of 
diphthongs  or  final  "e"s.  Then,  provision  is  made  for  the  exceptions  to  these 
cases.  Certain  syllables,  or  certain  vowel  and  consonant  patterns,  have  been 
found  to  be  exceptions  to  these  general  rules,  and  separate  provision  is  made 
for  them.  The  words  "area"  and  "areas"  are  exceptions  to  the  evaluation 
algorithms  but  occur  with  sufficient  frequency  to  make  it  worthwhile  to  treat 
them  as  a  special  case. 
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The  most  efficient  method  of  counting  syllables  was  derived  by  combining  a 
syllable  count  taken  from  the  beginning  of  the  word  forward,  together  with  one 
taken  from  the  end  of  the  word  backward.  Endings  are  stripped  from  the  word, 
counted  for  the  syllable  count,  and  their  letters  removed  from  further 
consideration.  Specific  suffixes  and  prefixes  are  recognized  and  their 
syllables  added  to  the  count.  A  complete  list  of  the  special  cases  treated 
can  be  derived  by  consulting  the  code  for  the  subroutine  SYLLY  in  the  ANALYSIS 
listing  which  follows  this  discussion. 

For  the  purposes  of  the  GRES  analysis,  certain  words  are  defined  as  having 
only  one  syllable.  The  numbers  one  through  nine  are  counted  as  one  syllable 
each.  Any  word  with  a  numeral  appearing  somewhere  within  it  is  also  counted 
as  having  one  syl lable.  Words  which  appear  on  a  selected  technical  word  list 
will  have  their  Mandatory  Technical  Word  flag  checked.  If  the  word  is  flagged 
as  a  Mandatory  Technical  Word,  it  is  counted  as  a  single  syllable. 

Certain  information  is  obtained  about  the  current  word  in  the  SPUNK  and 
SYLLY  subroutines  of  the  ANALYSIS  program.  Appropriate  flags  are  set  as  the 
information  is  obtained.  If  the  word  is  found  to  contain  invalid  characters 
it  is  placed  on  the  Uncommon  Word  List,  if  that  option  had  been  selected,  and 
not  processed  any  further.  An  invalid  word  will  nave  no  substitute  listed  in 
the  Word  Substitution  List,  and  neither  can  it  be  part  of  a  phrase  included  in 
the  Phrase  Substitution  List.  The  invalid  word,  and  any  preceding  words  in 
the  phrase  buffer,  can  be  added  to  the  output  line  without  further 
consideration. 

If  the  word  appears  to  be  valid,  each  specified  word  list  is  searched  for 
it  until  either  the  word  is  found  or  the  lists  are  exhausted.  If  the  word  is 
not  found  on  one  of  these  lists,  and  if  the  option  to  flag  and  list  uncommon 
words  has  been  selected,  then  the  word  will  be  included  on  the  Uncommon  Word 
List.  Uncommon  words  will  not  be  analyzed  any  further.  Any  word  which  is 
found  in  the  Acronym  or  Abbreviation  Glossary  is  also  exempted  from  further 
ana lys i s . 

If  the  word  is  found  in  one  of  the  other  lists,  its  attributes  can  be 
evaluated.  Flags  are  set  for  later  determination  of  preposition  count,  full 
or  truncated  passive  voice,  or  double  negatives,  depending  on  the  analysis 
options  selected  by  the  user.  If  the  option  to  include  substitutes  has  been 
selected,  each  word  is  considered  as  part  of  a  possible  phrase  on  the  Phrase 
Substitution  List.  A  phrase  buffer  holds  the  partial  phrase  as  it  is  being 
constructed.  As  each  word  is  added  to  the  phrase  buffer,  the  potential  phrase 
is  matched  against  the  Phrase  Substitution  List.  When  a  phrase  is  either 
completed  or  aborted  by  an  ineligible  word,  the  contents  of  the  phrase  buffer 

are  added  to  an  output  buffer  which  holds  the  line  of  output  text  currently 
being  built.  If  the  option  to  include  substitutes  has  not  been  selected,  each 
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word  is  immediately  added  to  the  output  line  being  built.  This  output  line  is 
comprised  of  the  original  text  and  punctuation,  with  any  of  the  editing 
suggestions  and  readability  counts  generated  by  the  analysis. 

After  each  page  of  output  is  generated,  the  user  options  are  checked  to 
determine  whether  an  interim  output  should  be  printed.  When  the  end  of  the 
document  has  been  reached,  if  an  interim  analysis  had  been  specified  it  is 
printed.  Then  the  final  reading  grade  level  analysis  and  uncommon  word  list 
is  generated.  If  no  interim  analyses  were  requested,  only  tne  final  reading 
grade  level  analysis  and  uncommon  word  list  are  generated.  In  either  case, 
normal  indication  of  characteristics  specified  in  the  option  selection  such  as 
uncommon  words,  passive  voice,  or  long  sentences  will  appear  throughout  the 
text. 

Figure  4  presents  a  flowchart  of  the  analysis  program.  A  complete  program 
listing  with  variable  dictionary  follows.  A  sample  input  text  and  the 
resultant  CRES  analysis  output  are  included  in  appendix  D. 
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000010  /* ********************************************* ******************/  JM 

000020  /*  PROGRAM  :  ANALYSIS  REVISED  :  11/18/83  */  JM 

000030  /*  PROGRAMED  QY:  JOHN  MEARS,  LESLIE  MONTGOMERY  fc  SUSAN  SCHALOW  */  JM 

000040  /*  */  JM 

000050  /*  THIS  IS  THE  ANALYSIS  PROGRAM  FOR  THE  VS  CRES  SYSTEM.  */  JM 

000060  /*  THIS  PROGRAM  ALLOWS  THE  USER  TO  SPECIFY  THE  DOCUMENT  */  JM 

000070  /*  TO  BE  ANALYZED,  AND  TO  SPECIFY  THE  OPTIONS  FOR  THE  */  JM 

000080  /*  ANALYSIS.  ALL  NECESSARY  WORD  LISTS  AND  FILES  ARE  */  JM 

000090  /*  OPENED,  PREFATORY  TO  PERFORMING  THE  ANALYSIS.  */  JM 

000100  /*  */  JM 

000110  /*  NOTE:  WPSBRTNB  IN  LIBRARY  @LINKLIB,  KICKOFF  IN  LIBRARY  */  JM 

000120  /*  */  JM 

000130  /*  CRES8SAV,  SCREEN  IN  LIBRARY  CRES@SAV,  AND  TITLPAGE  »/  JM 

000140  /*  - — —  -  -  -  */  JM 

000150  /*  IN  LIBRARY  CRES@SAV  ARE  LINKED  THROUGH  THE  FILES  OPTION.  */  JM 

000160  /*  */  JM 

000170  /*  WPSBRTNB  HANDLES  ALL  WORD  PROCESSING  COMMANDS.  */  JM 

000180  /*  KICKOFF  HANDLES  THE  DEFAULTS  FILE  FOR  USER  DEFAULTS.  */  JM 

000190  /*  SCREEN  HANDLES  THE  FIRST  SCREEN  ASKING  FOR  FILENAMES.  */  JM 

000200  /*  TITLPAGE  HANDLES  THE  HEADER  FOR  THE  OUTPUT  FILE.  */  JM 

000210  /*  ,  */  JM 

000220  /****»********»********»»**********»***»«****.*.****.»******»*.**/  JM 
000230  DIM  DOCFILS8,  DOCLIBS8,  DOCVOLS6,  TECFILS(7)8,  TECLI8$(7)8  JM 

000240  DIM  TECVOLS  (7)6,  PAG_TITL$60,  OPEN*  (13),  RCS1,  MSGS40,  LIB$1  JM 

000250  DIM  RGI41,  PREP_CNT$1,  PASSVS1,  LNG_PAR$1, IOBUFJ190, L$1  JM 

000260  DIM  UNCOM$l,  NEG$1,  INT_ANL$1,  NUM_SUB$1,  FC$<10)1  JM 

000270  DIM  ADVFNS1,  LNGjCLSSl,  PERS_SENT$1,  LNG_SENS1 , ABBRES ( 500) 20  JM 

000280  DIM  ID$5,  PRINTFL$8,  PLIB$8,  PVOL$6,  TABLES  ( 256)  1  JM 

000290  DIM  WORDPt24,TITLBUF$77,UCW$(500)  20,UCWCT%  (500)  ,C$2,LW»  (5)  JM 

000300  DIM  UCWFLG$(5I  1 ,  LSENT4  (  5)  ,  PR£PFL%  (  5)  ,  PASSVFS  (  5)  1 ,  DNFLS  (  5)  1  JM 

000310  DIM  NOUNFL$  (5)1,  LCLSFL%  ( 5)  ,SAVPH$  ( 5)  20,  SAVPHL4  (5)  ,  WSLS1  JM 

000320  DIM  LASTJ1,NP$2,TRNK_PV$1,SAVSYL%  ( 5)  ,  LNGWDSJ3,  LNGSNTS2  JM 

000330  DIM  NUM_SUBZ$1 ,  ENTERS 5,  PF$ 4  ,  PF1$3 ,  PF15$4, Q$1 , RUNLIBS8 ,  RUNVOL46  JM 

000340  DIM  ER479  ,MSG2$40  ,MSK$2,CMSG$255,  WORDQ$24  ,  BUFFAS  (40)  77 ,  R£$I  JM 

000350  DIM  UNC$(20)  20,F1$4,E$65,FX$1,IOBUFF$40,  INLIB$8,  INVOL46  JM 

000360  '  JM 

000370  /»*«***•****»*********************»*************»***********»**»./  jm 
000380  /*  */  JM 

000390  /*  VARIABLE  DICTIONARY  FOR  PROGRAM  ANALYSIS:  */  JM 

000400  /*  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  JM 

000410  /*  */  JM 

0004  20  /*  ABBRES  :  ARRAY  TO  HOLD  COMMONLY  USED  ABBREVIATIONS  AND  */  JM 

0004  30  /»  MNEMONICS;  */  JM 

000440  /*  ABBRE»  :  LENGTH  OF  ABBRE$  ARRAY;  */  JM 

000450  /*  ADVFNl  :  A  FLAG  TO  TELL  IF  ADVANCED  FUNCTIONS  ARE  REQUESTED;*/  JM 
000460  /*  BEGINYS  :  USED  TO  COMPUTE  STARTING  PAGE  NUMBER  FOR  PRTRGL;  */  JM 
000470  /*  BLANKS  :  A  FLAG  USED  TO  CATCH  PHRASES  WITHOUT  SUBSTITUTES;  */  JM 
000480  /»  BP*  :  BREAK  POINT;  */  JM 

000490  /*  BUFFAS  :  BUFFER  TO  PASS  BACK  INFO  FOR  PRINTFILE  HEADER;  */  JM 

000500  /*  BUFFERS  :  BUFFER  TO  HOLD  MESSAGE  FOR  INTERIM  OR  FINAL  RGL  */  JM 
000510  /*  REPORT;  */  JM 

000520  /*  C$  :  CONTROL  CHARACTER  FOR  FORMAT  STATEMENTS;  */  JM 

000530  /*  CLSPOSS  :  FLAG  TO  TELL  IF  END/START  OF  A  CLAUSE;  HAS  VALUES  */  JM 
000540  /*  1 B ’ “BEGINNING,  '  E'  “END,  ’  Y' "INTERMEDIATE;  */  JM 

000550  /*  CWS  :  COMMON  WORD  FLAG;  HAS  VALUES  '  ’  =ALLH  I GHT  (COMMON  WD.J,*/  JM 
000560  /*  '  Y1  =  PH  RASE  FOUND,  'N'=UNCOMMON  WORD,  1  X 1  -RETRY  */  JM 

000570  /*  D*  :  FLAG  TO  TELL  US  RETURN  CODE  FROM  PRT_WDS  */  JM 
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000580  /*  DNFLS  :  AN  ARRAY  TU  MARK  THE  LOCATION  OF  A  DOUBLE  NEGATIVE  */  JM 
000590  /*  OCCURRENCE;  */  JM 
000600  /*  DOCFI L$  :  THE  NAME  OF  THE  INPUT  DOCUMENT  FILE;  */  JM 
000610  /*  DOCLIB$  :  THE  NAME  OF  THE  INPUT  DOCUMENT  LIBRARY;  */  JM 
000620  /*  DOCVOLS  :  THE  NAME  OF  THE  INPUT  DOCUMENT  VOLUME;  */  JM 
000630  /*  ENDYS  :  USED  TO  COMPUTE  ENDING  PAGE  NUMBER  FOR  PRTRGL;  */  JM 
000640  /*  END_0_PAR$  :  END  OF  PARAGRAPH;  */  JM 
000650  /*  E_0_F$  :  FLAG  TO  INDICATE  END  OF  FILE;  */  JM 
000660  /*  PCS  :  AN  ARRAY  OF  FAC'S  USED  IN  WORD  LISTS  SELECTION;  */  JM 
000670  /*  FLAG*  :  A  FLAG  TO  INDICATE  TROUBLE  IN  FILE  SELECTION  IF  */  JM 
000680  /*  FLAG»-1;  */  JM 
000690  /*  FOUNDS  :  WORD  IN  WORD  LIST  FLAG;  HAS  VALUES  '  *  “CLEARING  */  JM 
000700  /*  FLAG,  'Y'=WORD  FOUND;  */  JM 
000710  /*  FI  :  PERCENT  OF  UNCOMMON  WORDS;  */  JM 
000720  /*  F2  :  PERCENT  OF  LONG  SENTENCES  */  JM 
000730  /*  HOME*  :  VARIABLE  USED  TO  DETERMINE  IF  USER  WISHES  TO  END  */  JM 
000740  /*  ANALYSIS  NOW;  HOME*  =  0  MEANS  NO,  =1  MEANS  YES;  */  JM 
000750  /*  10$  :  USED  AS  A  PARAMETER  FOR  'WPOPEN'  STATEMENT;  CREATED  */  JM 
000760  /*  BY  CONCATONATING  DOCUMENT  f  WITH  VOLUME  LETTER;  */  JM 
000770  /*  IDX*  :  POINTER  IN  UNCOMMON  WORD  TABLE;  */  JM 
000780  /*  IL*  :  (JOINTER  TO  ILINE$  TO  SHOW  POSITION  IN  INPUT  LINE;  */  JM 
000790  /*  I  LINES  :  BUFFER  TO  HOLD  EACH  LINE  OF  INPUT;  */  JM 
000800  /*  INT_ANL$  :  INTERIM  ANALYSIS  OPTION;  TELLS  US  TO  PRINT  */  JM 
000810  /*  SUMMARY  READING  GRADE  LEVEL;  */  JM 
000820  /*  INVLDS  :  INVALID  WORD  FIAG;  HAS  VALUES  '  1 , ' Y' = INVALID  WORD,*/  JM 
000830  /*  'P' -NUMBER  OR  GARBAGE  */  JM 
000840  /*  IO»  :  POSITION  IN  OUTPUT  LINE  (OLINES)  ;  */  JM 
000850  /*  IOBUFS  :  BUFFER  USED  TO  READ  INFO  FROM  THE  ABBREVIATION/  */  JM 
000860  /*  MNEMONIC  LIST;  */  JM 
000862  /*  IP*  :  POINTER  TO  THE  PHRASE  BUFFER;  */  JM 
000880  /*  IW*  :  A  POINTEK  TO  THE  ARRAY  OF  WORDS  LAST  FOUND  (WORDS$)  ;  */  JM 
000890  /*  LS  :  VAHIABLE  USED  TO  CATCH  TRAILING  PUNCTUATION  AND  PLACE  */  JM 
000900  /»  IT  OUTSIDE  OF  THE  SQUARE  BRACKETS  (  '  [  )')  WHEN  FLAGGING  */  JM 
000910  /*  UNCOMMON  WORDS;  */  JM 
000920  /*  L1*,L2*  :  VARIABLES  USED  TO  EXTRACT  SUBSTITUTES  FROM  WORD  */  JM 
000930  /*  SUBSTITUTION  LIST;'  */  JM 
000940  /*  LASTS  :  FLAG  TO  TELL  IF  INTERIM  RGL  HEADER  NEEDED  OR  TOTAL  */  JM 
000950  /*  RGL  HEADER  NEEDED;  */  JM 
000960  /*  LC»  :  THE  CUKHENT  LINE  COUNT;  */  JM 
000970  /*  LEN*  :  WORD  LENGTH;  */  JM 
000980  /*  LIBS  :  THE  1  CHARACTER  WORD  PROCESSING  DOCUMENT  LIBRARY  */  JM 
000990  /*  INPUT  BY  THE  USER;  USED  TO  CREATE  THE  8  CHARACTER  */  JM 
001000  /*  DOCLIBS  VARIABLE;  */  JM 
001010  /*  LIST*  :  A  COUNTER  OF  COMMAS  IN  LONG  SENTENCES  FOR  ’LIST?’  */  JM 
001020  /*  REMARK  IN  LONG  SENTENCES;  */  JM 
001030  /*  LL»  :  LINE  LENGTH;  */  JM 
001040  /*  LNGSNTS  :  THE  NUMBER  OF  SENTENCES  TO  FLAG  A  LONG  SENTENCE;  */  JM 
001050  /*  LNGWDSS  :  THE  NUMBER  OF  WORDS  TO  FLAG  A  LONG  SENTENCE;  */  JM 
001060  /*  LNG_CLS$  :  LONG  CLAUSE  OPTION;  */  JM 
001070  /*  LNG_PAR$  :  LONG  PARAGRAPH  OPTION;  */  JM 
001080  /*  LNG_SEN$  :  LONG  SENTENCE  OPTION;  */  JM 
001090  /*  LP»  :  LINES  PER  PAGE;  SET  AT  50;  */  JM 
001100  /*  LS*  :  NUMBER  OF  LONG  SENTENCES;  */  JM 
001110  /*  LSENT*  ( )  :  AN  ARRAY  USED  TO  MARK  THE  COUNT  AND  WHERE  THE  */  JM 
001120  /*  END  OF  A  LONG  SENTENCE  FALLS;  */  JM 
001130  /*  LW*  ( )  :  ARRAY  TO  HOLD  THE  LENGTH  OF  EACH  WORD  IN  WORDSS ;  */  JM 
001140  /*  MSGS  :  THE  MESSAGE  RETURNED  BY  THE  “LIMITS"  SUBROUTINE;  */  JM 
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001150  /*  NC%  :  NUMBER  OF  WORDS  PER  CLAUSE;  */  JM 
001160  /*  NEG$  :  NEGATIVE  OPTION  FLAG;  »/  JM 
001170  /*  NEG(l)  :  IF  »  2  THEN  DOUBLE  NEGATIVE  COUNT;  */  JM 
001180  /*  NEG(2)  :  DITTO;  */  JM 
001190  /*  NEG(3)  :  NEGATIVE  FLAG;  */  JM 
001200  /*  NP$  :  (CHARACTER)  PAGES  TO  ANALYZE  BEFORE  REPORTING  RGL;  */  JM 
001210  /*  NP%  :  (INTEGER)  PAGES  TO  ANALYZE  BEFORE  REPORTING  RGL;  »/  JM 
001220  /*  NSW  :  NUMBER  OF  SYLLABLES  PER  WORD;  */  JM 
001230  /*  NUM_SUBS  :  NUMBER  OF  SUBSTITUTES  OPTION;  INITIALIZED  TO  2;  */  JM 
001240  /*  NWS  :  NUMBER  OF  WORDS  PER  SENTENCE;  */  JM 
001250  /*  OLINES  :  THE  OUTPUT  LINE  BUFFER;  */  JM 
001260  /*  OPEN%  :  AN  ARRAY  OF  FLAGS  TO  INDICATE  WHICH  FILES  ARE  OPEN;  */  JM 
001270  /*  PAG_TITL$  :  PAGE  TITLE  INPUT  BY  USER;  */  JM 
001280  /*  PASSVJ  :  REGULAR  PASSIVE  VOICE  OPTION  FLAG;  */  JM 
001290  /*  PASSV%  :  PASSIVE  FLAG;  0 “CLEAR,  7-FLAG  SET;  */  JM 
001300  /*  PASSVFS  ;  AN  ARRAY  TO  MARK  THE  LOCATION  (IN  A  SENTENCE)  OF  */  JM 
001310  /*  PASSIVE  OR  TRUNCATED  PASSIVE  VOICE;  */  JM 
001320  /*  PC*  :  PAGE  COUNT;  */  JM 
001330  /*  PE%  :  PERSONAL  SENTENCE  COUNT;  */  JM 
001340  /*  PERSENT$  :  PERSONAL  SENTENCES;  */  JM 
001350  /*  PERS_S^NT$  :  PERSONAL  SENTENCE  OPTION;  */  JM 
001360  /*  PFLAG*  :  FLAG  TO  ASSIST  WITH  PRTLNE  SUBROUTINE;  TELLS  US  */  JM 
001370  /»  THE  STATUS  AFTER  RETURN;  */  JM 
001380  /•  PHCT%  :  A  COUNT  OP  SAVED  WORDS  FROM  POSSIBLE  PHRASES;  V  JM 
001390  /*  PLIB$  :  THE  LIBRARY  THAT  THE  OUTPUT  FILE  GOES  IN;  */  JM 
001400  /*  PREPFL*  ( )  :  AN  ARRAY  USED  TO  MARK  IF  THERE  ARE  TOO  MANY  »/  JM 
001410  /*  PREPOSITIONS,  THE  AMOUNT  OF  PREPOSITIONS,  AND  */  JM 
001420  /*  THE  LOCATION  IN  THE  SENTENCE  OF  THE  MARKING;  */  JM 
001430  /*  PREP_CNT$  :  PREPOSITION  COUNT  OPTION;  */  JM 
001440  /*  PRINTFLj  :  THE  FILENAME  OF  THE  OUTPUT  PRINT  FILE;  */  JM 
001450  /*  PS*  :  PREPOSITION  COUNT  FOR  EACH  SENTENCE;  */  JM 
001460  /*  PVOL*  :  THE  VOLUME  THAT  THE  OUTPUT  FILE  GOES  IN;  */  JM 
001470  /*  RC$  :  THE  RETURN  CODE  FROM  THE  "LIMITS*  SYSTEM  SUBROUTINE;  */  JM 
001480  /*  RECORDS  :  THE  RECORD  FOUND  ON  A  WORD  LIST  OF  THE  SPECIFIC  */  JM 
001490  /*  WORD  WE'RE  LOOKING  FOR;  */  JM 
001500  /*  REC1S  :  THE  RECORD  FOUND  CONTAINING  THE  SPECIFIC  WORD  AND  */  JM 
001510  /*  UP  TO  TWO  SUBSTITUTES;  */  JM 
001520  /*  RGLS  :  READING  GRADE  LEVEL  OPTION;  */  JM 
001530  /*  SAVPHS  :  AN  ARRAY  USED  TO  SAVE  WORDS  OF  POSSIBLE  PHRASES;  */  JM 
001540  /*  SAVPHL4  :  AN  ARRAY  USED  TO  SAVE  THE  LENGTH  (S)  OF  WORDS  OF  */  JM 
001550  /*  POSSIBLE  PHRASES;  »/  JM 
001560  /*  SAVSYL%  :  AN  ARRAY  USED  TO  SAVE  THE  SYLLABLE  COUNT  (S)  OF  */  JM 
001570  /*  WORDS  OF  POSSIBLE  PHRASES;  */  JM 
001580  /*  SC*  :  SENTENCE  COUNT;  »/  JM 
001590  /*  SENTPOSS  :  END/START  OF  A  SENTENCE;  VALUES  ARE  ' B' -BEGIN,  */  JM 
001600  /*  ' E* -ENDING;  */  JM 
001610  /*  SLC*  :  SYLLABLE  COUNT  SUBTOTAL  TOR  THIS  PASSAGE;  */  JM 
001620  /*  SP%  :  SENTENCES  PER  PARAGRAPH  COUNT;  */  JM 
001630  /*  TABLES  :  AN  ARRAY  TO  HOLD  ALL  CONTROL  CHARACTERS  WE  SHOULD  •/  JM 
001640  /*  NOT  BE  CONCERNED  WITH;  */  JM 
001650  /*  TECFILS  :  AN  ARRAY  TO  HOLD  THE  FILE  NAMES  TOR  THE  TECHNICAL  */  JM 
001660  /*  WORD  LISTS  INPUT;  */  JM 
001670  /*  TECH*  :  FLAG  TO  TELL  IF  WORD  IS  PRESENT  ON  TECHNICAL  WORD  •/  JM 
001680  /*  LISTS;  IF  SO,  TECH»=1;  ELSE  TECH4-0;  */  JM 
001690  /*  TECLIBj  :  AN  ARRAY  TO  HOLD  THE  LIBRARY  NAMES  FOR  THE  */  JM 
001700  /*  TECHNICAL  WORD  LISTS  INPUT;  */  JM 
001710  /*  TECVOLS  :  AN  ARRAY  TO  HOLD  THE  VOLUME  NAMES  FOR  THE  */  JM 
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001720  /*  TECHNICAL  WORD  LISTS  INPUT;  */  JM 
001730  /*  TITLBUFS  :  DUFFER  TO  HOLD  CENTERED  TITLE  FOR  OUTPUT;  */  JM 
001740  /*  TLC»  :  SYLLABLE  COUNT  FOR  EACH  WORD;  */  JM 
001780  /*  TPASSV*  :  FLAG  TO  KEEP  TRACK  OF  TRUNCATED  PASSIVE  VOICE;  */  JM 
001760  /*  TPASSV*=1  IMPLIES  'TO  BE'  FOUND,=3  IMPLIES  'TO  BE'*/  JM 
001770  /*  +  'PAST  PARTICIPLE'  FOUND;  */  JM 
001780  /*  TRNKPV*  :  TRUNCATED  PASSIVE  VOICE  OPTION;  “Y"  OR  “N" ;  */  JM 
001790  /*  UCW$  :  A  LARGE  ARRAY  TO  HOLD  UNCOMMON  WORDS;  */  JM 
001800  /*  UCWCT%  :  A  LARGE  NUMERIC  ARRAY  TO  HOLD  FREQUENCIES  OF  EACH  */  JM 
001810  /*  ENTRY  IN  THE  UCW*  ;  */  JM 
001820  /*  UCWFLG*  :  AN  ARRAY  USED  TO  TELL  IF  FORMER  POSSIBLE  PHRASE  */  JM 
001830  /*  WORDS  ARE  UNCOMMON;  */  JM 
001840  /*  UNC$  :  A  BUFFER  TO  HOLD  ALL  UNCOMMON  WORDS  FOR  EACH  */  JM 
001850  /*  SENTENCE;  WHEN  END  OF  SENTENCE  FOUND,  ADDED  TO  UCW$ ;  */  JM 
001860  /*  UNCPT*  :  A  POINTER  TO  THE  NEXT  AVAILABLE  LOCATION  IN  THE  */  JM 
001870  /*  UN C*  ARRAY  BUFFER  FOR  UNCOMMON  WORDS;  */  JM 
001880  /*  UNCOM*  :  UNCOMMON  WORD  OPTION;  IF  -'Y',  THEN  SAVE  UNCOMMON  */  JM 
001890  /*  WORDS  AND  LIST  AFTER  EACH  INTERIM  ANALYSIS;  */  JM 
001900  /*  UPDMSGS  :  THE  MESSAGE  FLASHED  TO  THE  USER  AFTER  INCREMENTS  */  JM 
001910  /*  OF  250  WORDS  HAVE  BEEN  EXAMINED  IN  UPDATE  SCREEN;  */  JM 
001920  /*  UW»  :  6JIJMBEK  OF  UNCOMMON  WORDS  SO  FAR;  */  JM 
001910  /*  WC»  :  WORD  COUNT;  */  JM 
001940  /*  WORDPS  :  THE  BUFFER  USED  TO  BUILD  POSSIBLE  PHRASES;  */  JM 
001950  /*  WORDS*  ()  :  A  SINGLE  DIMENSION  ARRAY  TO  HOLD  WORDS  AND  THEIR  */  JM 
001960  /*  SUBSTITUTES;  */  JM 
001970  /*  WOHDIJ  :  THE  INPUT  WORD  IN  ALL  CAPITALS;  */  JM 
001980  /*  WORD2S  :  HOLDS  THE  INPUT  WORD  WHILE  SYLLY  DEALS  WITH  EACH  */  JM 
001990  /*  PART'  OF  A  WORD  SEPERATEO  BY  A  SLASH  (*/")  OR  A  */  JM 
002000  /*  HYPHEN  */  JM 
002010  /*  WS4  :  WORDS  PER  SENTENCE  COUNT;  */  JM 
002020  /*  WSL$  :  P1JVG  TO  TELL  IF  WORD  FOUND  IN  WORD  SUBSTITUTION  LIST;*/  JM 
002030  /*  “N*  -  NO  6  "Y"  «  YES;  */  JM 
002040  /*  WWI»  :  USED  TO  COUNT  THE  NUMBER  OF  WORDS  PROCESSED  FOR  USER  */  JM 
002050  /*  UPDATE  OF  PROGRESS;  */  JM 
002060  /*  XI,S«  :  THE  GRAND  TOTAL  OF  I  TING  SENTENCES  1-  JR  ALL  ANALYSES;  */  JM 
002070  /*  XSC%  :  THE  GRAND  TOTAL  OF  SENTENCES  FOR  ALL  ANALYSES;  */  JM 
002080  /«  XSLC*  :  THE  GRAND  TOTAL  OF  SYLLABLES  FOR  ALL  ANALYSES;  */  JM 
002090  /*  XUC»  :  THE  GRAND  TOTAL  OF  UNCOMMON  WORDS  FOR  ALL  ANALYSES;  */  JM 
002100  /*  XWC%  :  THE  GRAND  TOTAL  OF  WORDS  FOR  ANALYSES;  */  JM 
002110  /*  */  JM 
002120  /••*•***********»*************************************••*•»•****»/  jm 
002130  F1$=HEX (A01400AA)  /»  FORMAT  FOR  READING  ABBREVIATIONS  */  JM 

002140  RE$,  RGI.$,  PREP _ Ctrl’* ,  PASSV* ,  LNG_PAK*  =  *Y"  JM 

002150  LNG_SEN*,  PERS_SENT*,  UNCOM*,  NEG*,  INT_ANL*  -  "Y"  JM 
002160  NUMSUDZS,  NUMSUB*,  TRNK  PV*,  LNG_CLS$  =  "Y"  JM 
002170  WSL*,ADVFN*=“N"  JM 
002180  NP»«5  JM 
002190  HOME»=0  JM 
002200  ENTER4=>"ENTER"  JM 
002210  PP*»“PF16"  JM 
002220  PF15*=“PFlb“  JM 
002230  l.NGWDS*3"  200"  JM 
002240  LNGSNT*-"10"  JM 
002250  NP$=*05"  JM 
002260  TECFILSO,  TECLIBSO,  TECVOLS  ( )  =  ALL(HEX(20)>  .JM 
002270  JM 
002280  CALL  "EXTRACT"  ADDU  (  "  I V"  ,  INVOLJ  ,  "SV"  ,  PVUL* ,  "  I L”  ,  INLII3*  ,  *SL"  ,  !  JM 


r-bU 
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002290  PLIB$,"RL",RUNLIB$,"RV",RONVOL$)  JM 
002300  SELECT  # 1,  "WPDOCMNT" ,VARC, INDEXED, RECSIZE-256,  :  JM 
002310  KEYPOS-01 ,  KEYLEN-20,  IOERR  GOTO  I0_ERR1  JM 
002320  SELECT  #2,  “CMNWDLST" ,  VARC,  INDEXED,  RECSIZE=  40,  JM 
002330  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR2  JM 
002340  SELECT  #3,  "WRDSBLST" ,  VARC,  INDEXED,  RECSI2E-80,  JM 
002350  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR3  JM 
002360  SELECT  #4,  "PHRSBLST" , VARC, INDEXED, RECSIZE-70,  JM 
002370  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR4  JM 
002380  SELECT  #5,  “TF.CHWL1"  ,  VARC ,  INDEXED,  RECSIZE-40,  JM 
002390  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERRS  JM 
002400  SELECT  #6,  "TECHWL2" , VARC, INDEXED, RECSIZE-40,  !  JM 
002410  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR6  JM 
002420  SELECT  #7,  "TECHWL3" , VARC, INDEXED, RECSIZE-40,  \  JM 
002430  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR7  JM 
002440  SELECT  #8,  “TECHWL4" ,  VARC,  INDEXED,  RECSIZE-40,  I  JM 
002450  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR10  JM 
002460  SELECT  19,  "TECHWLS" , VARC, INDEXED,  RECSIZE-40,  i  JM 
002470  KEYPOS-01 ,  KEYLEN-20,  IOERR  GOTO  I0_ERR11  JM 
002480  SELECT  #10,  "TECHWL6"  ,  VARC,  INDEXED,  RECSIZE-40 ,  !  JM 
002490  ^KEYPOS-01 ,  KEYLEN-20,  IOERR  GOTO  IO_ERRI2  JM 
002500  SELECT  #11,  “TECHWL7"  ,  VARC,  INDEXED,  RECSIZE-40 ,  JM 
002510  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR13  JM 
002520  SELECT  #12,  "PRNTFILE" , PRINTER, RECSI2E-80 ,  IOERR  GOTO  IO_ERR8  JM 
002530  SELECT  #13,  "ABBREFIL" ,  VARC,  INDEXED, RECSIZE-190,  \  JM 
002540  KEYPOS-01,  KEYLEN-20,  IOERR  GOTO  IO_ERR14  JM 
002550  SELECT  #14,  "TABLE',  CONSEC,  RECSIZE-256,  IOERR  GOTO  IO_ERR9  JM 
002560  CALL  "KIKOFF"  ADDR  ( RGL$ ,  PRKP_CNT$ ,  PASSV$,  LNG_SEN$ ,  LNG_PAR$  ,  :  JM 
002570  LNGWDSJ,  LNGSNT$,NEG$,0NCQM$,NDM_SDB$,INT  ANL$,NP$,ADVFNJ,  1  JM 
002580  PERS_SENT$,LNG_CLS$,TRNK_PVS,TECFIL$()  ,TECLIB$()  ,TECVOL$0  ,RE$,!  JM 
002581  INLIBS, INVOL$)  JM 
002590  DOCFI L$ - "  "  JM 
002600  DOCVOLS,  COMVOLS,  PHRVOLS ,  WRDVOL$  =  INVOL$  JM 
002610  COMLIB$ , PHRLI B$ , WRDLIBS- INLIB$  JM 
002620  SCRN:  JM 
002630  CALL  "SCRENZ"  (COMFILf  ,COMLI&$ ,  COMVOLS ,WRDFIL$, WRDLIB$  ,  JM 
002640  WRDV0L4 ,  PHRFILS ,  PHRLI  B$ ,  PHRVOLJ  ,  DOCFILS,  DOC  LIBS,  DOCVOLS,  1  JM 
002650  PAG_TITL$, LIBS, R£G%, INLIBS, INVOLJ)  JM 
002660  IF  REG4-0  THEN  ENDPRG  JM 
002670  FC$()-ALL(IIEX(81)  )  :  FCS  (8) -HEX  ( 8  2)  :  FCS  (9) -HEX  (80)  JM 
002680  FXS-HEX  ( 80  :E$="  "  JM 
002690  JM 
002700  /*  GET  NAME  OF  FILES  TO  USE  IN  PROG.  AND  PAGE  HEADER  »/  JM 
002710  JM 
002720  SCREN1 :  ACCEPT'  1  JM 
002730  AT  (01,03)  ,  I  JM 
002740  "CRES:  Document  Analysis  Subsystem  (Technical  File  Sele!  JM 
002750  ction  Screen)",  I  JM 
002760  AT  (02,03) ,  )  JM 
00  2770  "  =  =  =  —  JM 
002780  —  1  JM 
002790  AT  (04,10),  !  JM 
002800  "please  Identify  up  to  7  Technical  Word  Lists  to  be  used  in",  !  JM 
002810  AT  (05, 10) ,  I  JM 
002820  “the  analysis.",  I  JM 
002830  AT  (07, 10) ,  ;  JM 
002840  FAC  ( FX$ )  ,  K$  ,CH  (65)  ,  (  JM 
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002850 

AT 

(09,09) , 

002860 

■1. 

FILE  : 

,  m 

9 

002870 

AT 

(09,20)  , 

002880 

AT 

(09,32)  , 

002890 

"LIBRARY  i 

,  m 

t 

002900 

AT 

(09,43) , 

002910 

AT 

(09,55)  , 

002920 

■VOLUME 

# 

002930 

AT 

(09,65)  , 

002940 

AT 

(10,09) , 

002950 

"2. 

FILE  : 

,  m 

9 

002960 

AT 

(10,20), 

002970 

AT 

(10,32)  , 

002980 

"LIBRARY  : 

■ 

9 

002990 

AT 

(10,43)  , 

003000 

AT 

(10,55)  , 

003010 

"VOLUME 

9 

003020 

AT 

(10,65)  , 

003030 

AT 

(11,09)  , 

003040 

"3. 

FILE  : 

m 

9 

00  30  50 

AT 

(11, 20) , 

003060 

AT 

(11,32)  , 

003070 

"LIBRARY  : 

m 

9 

003080 

AT 

(11.43)  , 

003090 

AT 

(11,55) , 

003100 

■VOLUME  :* 

9 

003110 

AT 

(11,65)  , 

003120 

AT 

(12,09)  , 

003130 

*4. 

FILE  : 

m 

9 

003140 

AT 

(12,20)  , 

003150 

AT 

(12,32)  , 

003160 

"LIBRARY  : 

N 

9 

003170 

AT 

(12,43) , 

003180 

AT 

(12,55)  , 

003190 

"VOLUME 

9 

003200 

AT 

(12,65)  , 

003210 

AT 

(13,09)  , 

003220 

"5. 

FILE  : 

9 

003230 

AT 

(13,20)  , 

003240 

AT 

(13,32)  , 

003250 

■LIBRARY  : 

■ 

9 

003260 

AT 

(13,43)  , 

003270 

AT 

(13,55)  , 

003280 

■VOLUME 

9 

003290 

AT 

(13,65)  , 

003300 

AT 

(14,09)  , 

003310 

"6. 

FILE  : 

m 

9 

003320 

AT 

(14,20)  , 

00  33  30 

AT 

(14,32)  , 

003340 

■LIBRARY  : 

« 

9 

003350 

AT 

(14,43)  , 

003360 

AT 

(14,55)  , 

003370 

■VOLUME 

9 

003380 

AT 

(14,65)  , 

003390 

AT 

(15,09)  , 

003400 

"7. 

FILE  : 

■ , 

003410 

AT 

(15,20)  , 

FAC  ( FC$  (01)  )  ,  TEC'ILS(l) 

FAC (FC$ (01) ) ,  TECLIBS (1) 

FAC(FC$(01)J  ,  TECVOLS  (1) 

FAC (FCS (02) ) ,  TECFILS (2) 

FAC  (FC$  (02) )  ,  TECLIB$(2) 

FAC  ( FCS  (02) )  ,  TECVOL$  (  2) 

FAC  ( FC$  (03))  ,  TECFILS  (3) 

FAC  (FC$  (03)  )  ,  TECLIB$  (3) 

FAC(FC$  (03)  )  ,  TECVOL$  (3) 

FAC (FC$ (04) ) ,  TECFILS (4) 

FAC (FC$ (04) ) ,  TECLIBS (4) 

FAC  (FC$  (04)  )  ,'  TECVOLS  (  4 ) 

FAC  (FC$  (0  5)  )  ,  TECFILS  (  5) 

FAC  (FC$  (05) )  ,  TECLIBS(5) 

FAC(FC$(05)),  TECVOLS  (5) 

FAC(FC$  (06)  )  ,  TECF I  L$  (6) 

FAC  (FCS  (06)  )  ,  TECLIBS  (6) 

FAC  (FCS  (06)  )  ,  TECVOLS  (6) 

FAC  (  FCS  (07)  )  ,  TECFILS  (7) 


,  CH ( 08)  , 

,  CH  ( 08)  , 

,  CH (06) , 

,  CH ( 08)  , 

,  CH ( 08)  , 

,  CH ( 06)  , 

,  CH (08)  , 

,  CH  ( 08)  , 

,  CH  (06)  , 

,  CH(OB)  , 

,  CH (08)  , 

,  CH  (06)  , 

,  CH  ( 08)  , 

,  CH (08) f 

,  CH (06)  , 

.  CH(08)  , 

,  CH(08)  , 

,  CH  (  06)  , 


Zb< 


CH (08) 
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003420 

003430 

003440 

003450 

003460 

003470 

003480 

003490 

003500 

003510 

003520 

003530 

003540 

003550 

003560 

003570 

003580 

003590 

003600 

003610 

003620 

003630 

003640 

003650 

003660 

003670 

003680 

003690 

003700 

003710 

003720 

003730 

003740 

003750 

003760 

003770 

003780 

003790 

003800 

003810 

003820 

003830 

003840 

003850 

003860 

003870 

003880 

003890 

003900 

003910 

003920 

003930 

003940 

003950 

003960 

003970 

003980 


AT  (15,32)  , 


"LIBRARY 

AT  (15,43)  , 
AT  (15,55)  , 

■VOLUME 

AT  (15,65), 
AT  (21,28)  , 
“press" , 

AT  (21,34), 
AT  (21,40), 
"to  continue  ", 

AT  (22,19), 
"Press" , 

AT  (22,25), 
AT  (22, 30)  , 


FAC (FC$ ( 07) ) , 


FAC (FC$ (07) ) , 


FAC  ( HEX  (84 )  )  , 


FAC  (HEX  (84)  )  , 


TECLIB$ ( 7 ) 


TECVOLS  (7) 


ENTERS, 


PF15S, 


"to  return  to  the  previous  menu". 


AT  (23,18)  , 

"Press" , 

AT  (23,24),  FAC ( HEX (84) ) ,  PF$, 
AT  (23,29)  , 

"to  return  to  the  CRES  Master  Menu", 
KEYS (HEX (0010200F1F) ) ,  KEY(R£C4) 

E$=*  " 

IF  REC4=16  OR  REC%«32  THEN  ENDPRG 
IF  REC4 -15  OR  REC4-31  THEN  SCRN 


,  CH (08) , 


,  CH(06)  , 


XWC4  ,  XSC4 ,  XSLC4 ,  XUC4  ,  XLS4=*0  :  LAST$="N" 

FLAG*  =■  0  :  DOCLIBS-"  *  :WWU-0 

MAT  LSENT4  =  ZER  /*  INITIALIZE  VARIABLES  FOR  ANALYSIS 

IF  NUM_SUB$  =  ’0"  THEN  NUM_SUB$="N” 

IF  NUM  SUB$»"2"  THEN  NUM  SUB$*"Y" 


JM 

JM 


V 


/*  SEE  IF  FILES  EXIST  THAT  THE  USER  INPUT 


*/ 


FCS  ( )  -  ALL  (HEX  (81)  )  :  FCS  (8)  =HEX  (82)  :  FC$  (9)  =HEX  (80) 

FOR  14  =  1  TO  7 

FCS ( I % ) “HEX ( 81 ) 

IF  TECFILS (14) ="  *  AND  TECLIBS ( 14)  »"  ”  AND  i 

TECVOLS (14)“"  "  THEN  NI 

CALL  "LIMITS"  (TECFI LS  (14)  ,TECLIB$(I4)  ,TECVOL$(I4)  ,RC$,MSG$) 

IF  RC$="Y"  THEN  CALL  "KEAUFDR"  ADDR(TECFILS  (14)  , 

TECLIBS ( 14) , TECVOLS ( 14 ) ,  04 , "RS " , RAG4 , RET4) 

IF  RCSO’Y"  OR  RAG4O40  THEN  MESS 
J4-I4+4 

OPEN  NOGETPARM  *J4,  SHARED,  FILE=TECFIL$ ( 14)  ,  JM 

LIBRARY=TECLIB$(I4)  ,  VOLUME=TECVOL$  (14)  JM 


READ  t J4 ,  IOBUFFS  JM 

CLOSE  #J4  JM 

IF  STR ( IOBUFFS, 1, 16) ="  TECHNICAL  WORDS"  THEN  Nl  JM 

MESS:  FC$ (14) "HEX (91)  JM 

IF  RC$<>"Y"  THEN  ES-"  Indicated  file  doe3  not  exist.":  JM 

ELSE  E$="  Indicated  file  is  NOT  a  Technical  Word  List."  JM 

FX$=HEX (84)  JM 

I%"7  JM 

FLAG4  =1  JM 

NI:  NEXT  14  JM 

JM 
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003990  IF  FLAG»=1  THEN  SCREN1  JM 
004000  FOR  I%=1  TO  6  /*  MAKE  SURE  USER  DIDN'T  SPECIFY  DUPLICATES  */  JM 
004010  FOR  JI»=I%+1  TO  7  JM 
004020  IF  TECFIL$ ( 1% ) ■"  *  THEN  JIt»8  JM 
004030  IF  TECFILS  ( 14)  ""  *  THEN  NIN  JM 
004040  IF  TECFILS  ( 14)0  TECFIL$  ( JI4)  THEN  NIN  JM 
004050  IF  TECLIBS  (I»K>  TECLIBS  (JI4J  THEN  NIN  JM 
004060  IF  TECVOLf  (I4)<>TECVOL$(JI4)  THEN  NIN  /*  DIFF.  VOLS  */  JM 
004070  FC$(I%)«HEX(91>  /*  SETT  THE  FAC'S  */  JM 
004080  FC$ ( J I  %  > *H£X ( 91J  JM 
004090  E$="  Duplicate  Lists  were  specified."  JM 
004100  FX$“H£X ( 84)  JM 
004110  I»  =  7  /*  GET  OUT  OF  THE  LOOP  */  JM 
004120  JI4=8  JM 
004130  FLAG«=1  /*  SET  THE  FLAG  */  JM 
004140  NIN:  NEXT  JI%  JM 
004150  NEXT  1%  JM 
004160  IF  FLAG4=1  THEN  SCREN1  JM 
004170  IF  PAGjriTLS  =  *  "  THEN  OPT_SCRN  JM 
004180  IDENT4-  ( (LEN (PAGTITLS) ) /2 )  JM 
004190  TITLBUF$-ALL(HEX(20) )  JM 
004200  STR (TITLBUFS , 34-IDENT4)  -  PAG_TITL$  JM 
004210  JM 
004220  /*  GET  OPTIONS  FROM  THE  USER.  */  JM 
004230  JM 
004240  OPTSCRN:  JM 
004250  IF  NUM_SUBS="2"  THEN  NUM_SU8$=“Y"  JM 
004260  IF  NUM  SUBS*" 0"  THEN  NUM_SUB$»‘N*  JM 


JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 


Z64 


004270  ACCEPT 

004280  AT  (01,03), 

004290  "CRES:  Document  Analysis  Subsystem  (Option  Sele 

004300  ction  Screen)", 

004310  AT  (02,03)  , 

004330  =*==  =  **=■  =  =  *  =  *", 

004340  AT  (04,10), 

004350  "Default  options  are  listed  below.  They  may  be  changed  as", 
004360  AT  (05,10) , 

004370  "appropriate  for  the  current  document  analysis.", 

004380  AT  (07,19), 

004390  "1.)  Report  Reading  Grade  Level ....( Y/N) “ , 


004400  AT  (07,59),  KGI4  ,  CH(01), 

004410  AT  (08,19), 

004420  "2.)  Count  Prepositions . (Y/N)", 

004430  AT  (08,59),  PREP_CNT$  ,  CH(01), 

004440  AT  (09,19), 

004450  "3.)  Plag  Passive  Voice . (Y/N)", 

004460  AT  (09,59),  PASSVJ  ,  CH(01) , 

004470  AT  (10, 19) , 

004480  "4.)  Flag  Long  Sentences . (Y/N)", 

004490  AT  (10,59),  LNGSENS  ,  CH(01), 

004500  AT  (11,19), 

004510  "5.)  Flag  Long  Paragraphs . (Y/N)*, 

004520  AT  (11,59),  LNG_PAR$  ,  CH(01), 

004530  AT  (12,23), 


004540  "If  YES,  How  Long?", 

004550  AT  (12.42) ."Words 
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004560  AT  (12,59),  FAC  (HEX  (82)  )  ,  LNGWDSJ,  CH(03),  RANGE  ( "001" ,  *999*)  ,  JM 

004570  AT  (13,42),  "Sentences . ",  1  JM 

004580  AT  (13,59),  FAC  (HEX (82) ) , LNGSNT$,  CH(02),  RANGE ( “01“ , "99")  , 1  JM 

004590  AT  (14,19),  1  JM 

004600  “6.)  Flag  Double  Negatives . (Y/N)*,  1  JM 

004610  AT  (14,59),  NEG$  ,  CH(01),  JM 

004620  AT  (15,19),  !  JM 

004630  ”7.)  Flag  &  List  Uncommon  Words. ... (Y/N)  * ,  !  JM 

004640  AT  (15,59),  UNCOMJ  ,  CH(01),  1  JM 

004650  AT  (16,19) ,  !  JM 

004660  “8.)  Include  Substitutes....  . (Y/N) * ,  1  JM 

004670  AT  (16,59),  NUMSUOS  ,  CH(01),  J  JM 

004680  AT  (17,19),  1  JM 

004690  ”9.)  Interim  Analyses . (Y/N)“,  l  JM 

004700  AT  (17,59),  INT_ANL$  ,  CH(01),  JM 

004710  AT  (18, 18) ,  I  JM 

004720  "10.)  Number  of  Pages  Between  Reports....",  1  JM 

004730  AT  (18,59),  FAC (HEX (82) ) ,  NP$,  CH(02) ,  RANGE ( "01" , "99 ") ,  1  JM 

004740  AT  (19,18)  ,  '.  JM 

004750  "11.)  Check  Personal  Sentences . (Y/N)",  1  JM 

004760  AT  (19,59),  PERSSENTS  ,  CH(01),  !  JM 

004770  AT  (20,18)  ,  .'  JM 

004780  “12.)  Check  Truncated  Passive  Voice. (Y/N) ",  !  JM 

004790  AT  (20,59),  TRNKPVJ  ,  CH(01),  !  JM 

004800  AT  (  22,  27)  ,  JM 

004810  "Press",  !  JM 

004820  AT  (22,33),  FAC (HEX (84) ) ,  ENTERS,  !  JM 

004830  AT  (22,39),  l  JM 

004840  “to  continue  ",  '.  JM 

004850  AT  (23,20),  !  JM 

004860  "Press",  !  JM 

004870  AT  (23,26),  FAC ( HEX ( 84) ) ,  PF15$,  !  JM 

004880  AT  (23,31) ,  1  JM 

004890  "to  return  to  previous  menu  ",  !  JM 

004900  AT  (24, 18) ,  1  JM 

0049 L0  “Press",  '  !  JM 

004920  AT  (24,24),  FAC  ( HEX  ( 84)  )  ,  PF$,  !  JM 

004930  AT  (24,29),  I  JM 

004940  "to  return  to  CRES  Master  Menu",  !  JM 

004950  KEYS  (HEX  (OOlOrOOFlF)  )  ,  KEY  (RKC»)  JM 

004960  IF  REC»*16  OR  REC%=32  THEN  ENDPRG  JM 

004970  IF  KKC4-15  06  RKC%=31  THEN  SCREN1  JM 

004980  IF  LNG_PARJ-"Y"  THEN  CONVERT  LNGWDSJ  TO  LNGWDS4  JM 

004990  IF  LNG_rAR$’"Y“  THEN  CONVERT  LNGSNTS  TO  LNGSNTS  JM 

005000  NUM  SUBZS-NUM  SUBS  .  JM 

005010  IF  NUM_SUH$  =  ’Y"  THEN  NUM_SUB$  =  “2“  ELSE  NUM_SUB$="0"  JM 

00  5020  CONVERT  N F$  TO  NPS  /*  ANALYSIS  USES  NUMERIC  */  JM 

005030  UPS=NP»  :GP%-NP%  /*  SET  UP  BREAK  POINT  •/  JM 

005040  JM 

005050  JM 

005060  /*  FIRST,  LET'S  STORE  DEFAULTS  IF  NECESSARY  »/  JM 

005070  JM 

005080  IF  HK$0"I."  THEN  OPEN_DOCl  JM 

005090  CALI.  "K1KUFF"  ADDK  (  RGL$  ,  PREP_CNT$ ,  PASSV$  ,  LNG_SEN$  ,  LNG_PAR$  ,  1  JM 

005100  LNGWDSJ,  LNGSNTS,  NEGS ,  UNCOMS  ,  NUM_SUB$ ,  INT_ANL$,  NP$,  ADVFN$ ,  •  JM 

005110  PFK.5_SENT$,LNG_C1,S$,TRNK_PV$,TECFIL$()  , TECLIBJ  ( )  ,TECVOL$  0  ,  RE$  ,  !  JM 
0051 n  I NLIDJ, INVOLJ)  JM 


/bb 
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005120 

005130 

005140 

005150 

005160 

005170 

005180 

005190 

005200 

005210 

005220 

005230 

005240 

005250 

005260 

005270 

005280 

005290 

005300 

005310 

005320 

005330 

005340 

005350 

005360 

005370 

005380 

005390 

005400 

005410 

005420 

005430 

005440 

005450 

005460 

005470 

005480 

005490 

005500 

005510 

005520 

005530 

005540 

005550 

005560 

005570 

005580 

005590 

005600 

005610 

005620 

005630 

005640 

005650 

005660 

005670 

005680 


/*  open  the  document  to  be  analyzed  on  |1  for  input  */ 

OPEN_DOC 1 :  IF  OPEN»(l)  «  1  THEN  CALL  "WPCLOSE"  ADDR ( RET*  ,# 1 ) 

SELECT  WS 

IDS»STR(DOCFIL$,l,4)  6.  LIBS 

.  CALL  "WPOPEN"  ADDR  (RET* ,  « 1 , 10$ ,  "  I  “  ,  0%  ,  DOCFILi ,  DOCLIBS  ,  DOCVOLS) 

IF  RET*=0  THEN  MORE 

PRINT  AT  (22,1)  .-"Error  on  WPOPEN  #1  * 

GOTO  IO_ERRl 

MORE:  OPEN* (1)  =  1 

CALL  "WPSTART"  ADDR  ( RET* , #1, 1* , 2») 

IF  RET*  »  0  THEN  AOK1 

PRINT  AT  (22,1) ; "Error  on  WPSTART  -  First  #1“ 

GOTO  IOERR1 

/*  TEMPORARY  ASSIGNMENT  FOR  INLIBS  */ 

AOK1 :  f 

IF  OPEN* (2)  -  1  THEN  CLOSE  42 

OPEN  NOGETPARM  #2,  SHARED,  FILE-COMFILS,  I 

LIBRARY=COMLIB$,  VOLUME=COMVOL$ 

OPEN*  (2)  »  1 

IF  OPEN* (3)  »  1  THEN  CLOSE  |3 

OPEN  NOGETPARM  #3,  SHARED,  FILE=>WRDFIL$,  ! 

LIBRARY=WRDLIB$,  VOLUME=WRDVOL$ 

OPEN*  (3)  =  1 

IF  OPEN* (4)  =  1  THEN  CLOSE  #4 

OPEN  NOGETPARM  14,  SHARED,  FILE*  PHRFILS,  I 

LIBRARY=PHRLIB$,  VOLUME=PHRVOL$ 

OPEN* (4)  =  1 

FOR  I*  *  1  TO  7 

IF  TECFIL$ (!»)*"  "  THEN  NT I 

J»*I»+4 

IF  OPEN* ( J* )  =  1  THEN  CLOSE  |J* 

OPEN  NOGETPARM  »J»,  SHTiRED,  FI LE-TECFI L$  ( I »)  ,  ! 

LIBRARY-TECLIBSU*)  ,  VOLUME -TECVOLS  ( I») 

OPEN* ( J*)  »  1 

NTI :  NEXT  I* 

PR INTFL$* "ANA LYS| # "  :  I*  =  0 

C:  CONVERT  I*  TO  STR(PRINTFLS, 7, 2) ,  PIC(00) 

CALL  "LIMITS"  (PRINTFLS , PLIB$ , PVOL$ , RC$  , MSG$) 

I»*I»+1 

IF  RC$  -  "Y"  THEN  C 

IF  OPEN* (12)  =  1  THEN  CLOSE  • 1 2 

OPEN  NOGETPARM  »i2,  OUTPUT,  F I  LE=PH  I NTFI4 ,  I 

LIBRARY=PLIB$,  VOLUME  *  PVO  L3 
OPEN*  (12)  *  1 

ABBRE4-0 
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005690  CALL  *  LIMITS"  ( "ABBRELST"  ,  INLIBS ,  INVOLS,  RC$, MSGS) 

005700  IF  RC$  <>  *Y"  THEN  SK 

005730 

005740  OPEN  NOGETPARM  #13,  SHARED,  FILE3 "ABBRELST",  1 

005750  LIBRARY3  INLIB$  ,  VOLUME  =  INV0I4 

005770  READ  #13,  IOBUF$  /*  GETS  RID  OF  ABBREVIATION  HEADER  */ 

005780  I%=1 

005790  REED:  READ  #13,  IOBUFS,  EOD  GOTO  CONT 
005800  SUNPACK  (F»F1S)  IOBUFS  TO  ABBRE$(I») 

005810  I%«I%H 

005820  GOTO  REED 

005830 

005840  CONT:  CLOSE  #13 

005850  ABBRE%=  14-1  /*  SET  ABBREVIATION  ARRAY  LENGTH  */ 

005860  SK.-OPEN  NOGETPARM  #14,  INPUT,  FILE-*ELIMSPCH",  LIBRARY3 INLIBS,  1 

005870  VOLUME3 INVOLS 

005880 

005890  READ  #14,  STR (TABLES ( I  ,, 256) ,  EOD  GOTO  IO_ERR9 
005900 

005910  CLOSE  #14 

005920  , 

005930  GOSUB  ANALYZE  /*  ANALYZE  TEXT  PILES  */ 

005940 

005950  GOSUB  CLSFL  /*  CLOSE  ALL  FILES  */ 

005960 

005970  GOSUB  ANLDISP  /*  DISPLAY  OR  PRINT  OUTPUT  SCREEN  */ 

005980  IF  HOME4  =  l  THEN  ENDPRG  /*  END  THE  PROGRAM  NOW  •/ 

005990  GOTO  SCRN 
006000 

006010  /*•**»«******************»***»**»********************************/ 


006020  /*  */ 

006030  /*  THIS  SUBROUTINE  GENERATES  A  SCREEN  FOR  THE  USER  TO  DECIDE  */ 

006040  /•  HOW  HE/SHE  WOULD  LIKE  TO  SEE  THE  GENERATED  OUTPUT.  */ 

006050  /*  */ 

006060  /******•*•**•*******************»**••*•»***»*•*•••»»»****«*♦***•»/ 


006070  ANLDISP: 

006080  ERS-"  " 

006090  PF1S-"PF1" 

006100  CWMENU: 

006110  ACCEPT 

006120  AT  (01,03), 

006130  'CUES:  Document  Analysis  Subsystem  (Display  of  Ana 

006140  lysis  Screen)", 

006150  AT  (02,03), 

006160  "33==33»--3-=«»=»»»3333  =  =  »= 3  3===  =  =  =  «»==  =  =  =  »  =  =  »  =  =  »«  =  =  =  *  =  =  =  »  =  =  = ==  =  =  === 
006170  ==33333333333" , 

006100  AT  (05,14), 

006190  "CKES  Analysis  as  specified  has  been  completed.  Your", 

006200  AT  (06,14), 

006210  "output  file  is  in  the  Print  Queue  and  named  as  follows:", 

006220  AT  (10,12), 

006230  "FILE:", 

006240  AT  (10,18),  FAC  (HEX  (84)  )  ,  PKINTFLS,  CH(08), 

006250  AT  (10,33), 

006260  "LIBRARY:", 

006270  AT  (10,42),  FAC (HEX (84) ) ,  PLIB$,  CH(08), 

0062HO  AT  (10,  57)  , 


] 


JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 
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JM 

JM 

JM 
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JM 
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JM 

JM 

JM 

JM 

JM 

JM 

JM 
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JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 
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006290 

006300 

006310 

006320 

006330 

006340 

006350 

006360 

006370 

006380 

006390 

006400 

006410 

006420 

006430 

006440 

006450 

006460 

006470 

006480 

006490 

006500 

006510 

006520 

006530 

006540 

006550 

006560 

006570 

006580 

006590 

006600 

006610 

006620 

006630 

006640 

006650 

006660 

006670 

006680 

006690 

006700 

006710 

006720 

006730 

006740 

006750 

006760 

006770 

006780 

006790 

006800 

006810 

006820 

006830 

006840 

006850 


"VOLUME:",  JM 

AT  (10,65),  FAC  (HEX  (84 )  )  ,  PVOL$,  CH(06),  1  JM 

AT  (13,02),  FAC  (HEX  (94)  )  ,  ER$ ,  JM 

AT  (16,21),  1  JM 

"Press",  I  JM 

AT  (16,27),  FAC  ( HEX  (84)  )  ,  PF1J,  CH(03),  JM 

AT  (16, 31) ,  I  JM 

“to  display  file  at  terminal",  I  JM 

AT  (17,21),  !  JM 

"Press",  1  JM 

AT  (17,27),  FAC  ( HEX  (84)),  PF15$,  CH(04),  i  JM 

AT  (17,32),  !  JM 

"to  analyze  another  text",  !  JM 

AT  (18,21),  !  JM 

“Press",  I  JM 

AT  (18,27),  FAC  (HEX  (84 ) )  ,  PF$,  CH(04),  '.  JM 

AT  (18,32),  I  JM 

"to  return  to  CRES  Master  Menu",  !  JM 

KEYS(HEX(01110F1F1020)  )  ,KEY(R£C»)  JM 

IF  REC4-15  OR  REC»=31  THEN  RETURN  JM 

IF  REC%=16,OR  REC%=32  THEN  H0ME%  =  1  JM 

IF  HOME4-1  THEN  RETURN  JM 

JM 

CLOSE  WS  JM 

MSG2$  =  "CANCEL  Processing"  JM 

MSKS-HEX(OO)  JM 

CMSG$  -  *  *  JM 

CALL  "LINK"  ADDR("ANALDISP",*P",RUNLIB$,RUNVOL$,3»,  !  JM 

PRINTFLS, PLIB$ , PVOL$ , "C" ,M5G2$ , 274 , "H" ,MSK$ ,CMSG$,  !  JM 

255% , C% , R%)  JM 

ER$  =  "  "  JM 

IF  C%  =  0  AND  R%=0  THEN  RETURN  JM 

IF  C%O0  OR  R%<>0  !  JM 

THEN  ERJ  -  STR(CMSG$,  141)  JM 

GOTO  CWMENU  JM 

*.****..***.*..**........./JM 

/*  */  JM 

/*  THIS  SUBROUTINE  CLOSES  ANY  FILES  THAT  ARE  STILL  OPEN.  */  JM 

/*  */  JM 

/*.*»***..».*.**.**».».»*•*.»•*••.*.»********»•****»»**»*»•***»*»/  JM 

CLSFL:  JM 

FOR  I%  =  2  TO  13  JM 

IF  OPEN%(I%)  =■  1  THEN  CLOSE  #i%  JM 

NEXT  1%  JM 

IF  OPEN% ( I )  -  1  THEN  CALL  "WPCLOSE"  ADDR ( RET% ,11)  JM 

MAT  OPEN%=ZER  JM 

RETURN  JM 

JM 

ENDPRG :  GOSUB  CLSFL  :  END  /*  END  THE  PROGRAM  NOW  */  JM 

JM 

10  ERR1:  PRINT  AT(23,1),  “I/O  ERROR  ON  DOCUMENT  FILE,  *1.  FILE";:  JM 
*  STATUS  IS  :  " ; RET% ;  "AND  ";  FS(#1)  JM 

STOP  "PRESS  ENTER  TO  CONTINUE"  JM 

GOSUB  CL5PL  :  GOTO  SCRN  JM 

JM 

IO  ERR2:  PRINT  AT ( 2 3 , 1 )  ,  "I/O  ERROR  ON  COMMON  WORD  LIST  FILE,  #2"!  JM 
FILE  STATUS  IS  :  ";FS(|2)  JM 


268 
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006860 

006870 

006880 

006890 

006900 

006910 

006920 

006930 

006940 

006950 

006960 

006970 

006980 

006990 

007000 

007010 

007020 

007030 

007040 

007050 

007060 

007070 

007080 

007090 

007100 

007110 

007120 

007110 

007140 

007150 

007160 

007170 

007180 

007190 

007200 

007210 

007220 

007230 

007240 

007250 

007260 

007270 

007280 

007290 

007300 

007310 

007320 

007330 

007340 

007350 

007360 

007370 

007380 

007390 

007400 

007410 


STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IO_ERR3:  PRINT  AT(23,1),  "I/O  ERROR  ON  WORD  SUBST.  LIST  FILE,  #3"! 
;".  FILE  STATUS  IS  :  ";  FS(#3) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 


IO  ERR4:  PRINT  AT(23,1),  "I/O  ERROR  ON  PHRASE  SUBST.  LIST  FILE";  ! 
"  |4.  FILE  STATUS  IS  :  *;FS(*4) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IO_ERR5:  PRINT  AT(23,1),  "I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  IS";! 
".  FILE  STATUS  IS  :  ";FS(#5> 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IOERR6:  PRINT  AT(23,1),  "I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  16“;! 
".  FILE  STATUS  IS  :  ";FS(|6) 

,  STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IO_KKR7:  PRINT  AT(23,1J,  “I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  |7";! 
",  FILE  STATUS  IS  :  *;FS(|7) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 


IO_£RR8:  PRINT  AT(23,1),  "I/O  ERROR  ON  PRINT  FILE,  #12.  FILE  ST";! 
"ATUS  IS  :  " ;FS (112) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 


IO_ERR9:  PRINT  AT(23,lJ,  "I/O  ERROR  ON  TABLE  FILE,  #14.  FILE  ST";! 
"ATUS  IS  :  *;FS(#14) 

STOP  “PRESS  ENTER  TO' CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 


lO_EKK10 : PRINT  AT(23,1),  "I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  #8";! 
FILE  STATUS  IS  :  ";FS(#B) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IOERR11: PRINT  AT(23,1),  "I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  #9“;! 
".  FILE  STATUS  IS  ;  ";FS(#9i 
STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IO_ERR12:  PRINT  AT  (23, 1)  ,  "I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  #10";  ! 
".  FILE  STATUS  IS  :  *;FS(#10) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

IO_EKK13:PKINT  AT  ( 2  3, 1 )  ,  "  I/O  ERROR  ON  TECH.  WORD  LIST  FILE,  #11";! 
*.  FILE  STATUS  IS  :  ";FS(#11) 

STOP  "PRESS  ENTER  TO  CONTINUE" 


007420 


GOSUB  CLSFL  :  GOTO  SCRN 


JM 


JM 

JM 

JM 

,7M 

JM 
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007430 

007440 

007450 

007460 

007470 

007480 

007490 

007500 

007510 

007520 

007530 

007540 

007550 

007560 

007570 

007580 

007590 

007600 

007610 

007620 

007630 

007640 

007650 

007660 

007670 

007680 

007690 

007700 

007710 

007720 

007730 

007740 

007750 

007760 

007770 

007780 

007790 

007800 

007810 

007820 

007830 

007840 

007870 

007880 

007890 

007900 

007910 

007920 

007930 

007940 

007950 

007960 

007970 

007980 

007990 

008000 

008010 


IO_EKR14:  PRINT  AT(23,1),  "I/O  ERROR  ON  ABBREVIATION  PILE,  #13";'. 
*.  FILE  STATUS  IS  :  *;FS(|13) 

STOP  "PRESS  ENTER  TO  CONTINUE" 

GOSUB  CLSFL  :  GOTO  SCRN 

/***»***«***********»**»*»********»**»*********»********»»*******/ 

/*  V 

/*  THIS  SUBROUTINE  ANALYZES  A  DOCUMENT  FILE  AND  OUTPUTS  */ 
/*  THE  RESULT  IN  A  PRINT  FILE.  SEVERAL  OPTIONAL  WORD  LISTS  MAY  */ 
/*  BE  USED  IN  THE  ANALYSIS.  */ 

/*  V 

/ . . . 

ANALYZE: 

/*  DECLARE  MORE  VARIABLES  */ 


DIM  ILINE$(1)80,  WORUOJ20,  RECOKD$40, PR£C$70, REC1J80, BLANKJ1 
DIM  OLINE$77,  WORDS$80,  WORD1S24,  BB$1,  BC$1,  BS$1,  AJ1 
DIM  INVLDS1,  CW$1,  FOUNDJ1,  CLSPOS51 ,  Tl$l,  T2$l, T3$l,  E_0_F$1 
DIM  SENTPOSJl,  NEG»(3),  PERSENTJl ,  END_0_PAR$1,  WORDS$(2)160 
DIM  Zl$l,Z$2,Z2$3,UPUMSG$51,WORD2$24,BEGINY$3,ENDY$3,BUFPER<33 
DIM  SAVSUBJ  ( 5)  40,SAVSUBL%  (5)  ,SAVREC1S(5)  80,WORDZ$80 
BLANK$-"N" 

MAT  SAVSUBL%  =  ZER 

WW1S-0  :WW«-0  /*  INITIALIZE  UPDATE  VARIABLES  */ 

GOSUB  UPDATE 

CALL  "TTLPGE"  ADDR  (8UFFA$  ( )  ,  PAG_TITL$  ,DOCFIL$,  LIB$ ,  DOCVOL$, 
RGLJ  ,  PREP  CNTJ ,  PASS V$ ,  LNG  SENS,  LNG  PA R$ ,  LNGWDSS ,  LNGSNTS , 
NEGS ,  UNCOMJ  ,  NUM  SUBZS,  INT  ANLS ,  NP$ ,  ADVFN$ ,  PERSSENTS , 

lng_cls$,trnk_pv$,tecfil$o  ,teclib$d  ,tecvoi40  ,ie%) 


GOSUB  TTLPGE 
GOSUB  SETUP 
CLGW: 


/*  INITIALIZE  PROG.  */ 


/»  GET  NEXT  WORD  */ 

GOSUB  GETWORD 

ON  (I»+l)  GOTO  IO  ERKI,  WDFND,  BLDOPL,  BLDOPL,  WFO 


WDPND: 

GOSUB  CHKWORD 
IF  I»«0  THEN  WFO 

/*  CASES  OF  NO  ANALYSIS  */ 

IF  NUM_SUB$  =  "2"  AND  CWJO'N"  THEN  CHKPHR 
IF  CW$  =  "N"  OR  UNCOM4  <>  "Y"  THEN  BLDOPL 
IF  NUM_SUB$<>"2"  THEN  BLDOPL 

/•  CHECK  PHRASE  FILE  */ 

CHKPHR:  GOSUB  CHKPHSPI. 

IF  I»-0  THEN  WFO 
IF  CW$<>’P"  THEN  BLDOPL 


/*  ANALYZE  WORD  */ 


/*  NO  PARTIAL  PHRASE  FOUND  */  JM 
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008020 

0080  30  /*  MUST  HAVE  FOUND  PARTIAL  PHRASE  -  SAVE  IT  AND  TRY  AGAIN  */ 

008040 

008050  SAVPH$(t‘.ICT%)=STR(WORDSS,l,WLEN»)  /*  SAVE  THE  WORD*/ 

008060  SAVPHL*  (PHCT%)  =WLEN»  /*  SAVE  THE  WORD'S  LENGTH  */ 

008070  SAVSYL%  (PHCT%)  »TLC%  /*  SAVE  THE  SYLLABLE  COUNT  */ 

008080  IF  WSLSO'Y"  THEN  PHCT»-PHCT%+1  /*  INCREMENT  PHCT»  */ 

008090  '  IF  WSL40"Y*  THEN  CLGW  /*  NO  NEED  TO  SAVE  SUBS.  */ 

008100  SAVRECll  <PHCT»)  -REC1$  /*  SAVE  THE  RECORD  »/ 

008110 

008120  /*  SINCE  THIS  WORD  SUBSTITUTE  COULD  BE  TAKEN  CARE  OF  IN  SEVERAL  */ 
008130  /»  PLACES  IN  THIS  PROGRAM,  WE  NEEDED  TO  SAVE  IT  TWO  WAYS  -  AS  A  */ 

008140  /*  RECORD  (SAVREC1J)  AND  AS  COMPONENTS  (SAVSUBJ  &  SAVSUBH)  */ 

008150 

008160  Kl%— 1 

008170  K1«»POS(STR(REC1$,21,20)  ■*  *) 

008180  SUBZ:  IF  STR (REC1$, Kl»  +  21, 1)  «"  "  OR  K14-20  THEN  CNT1 
008190  K4%-POS(STR(REC1$,K1»+21,20-K1%)-"  *)  /*  GET  THE  REST  */ 

008200  IF  K4»=»0  THEN  Kl»-20  /*THE  SUBSTITUTE  TOOK  20  SPACES*/ 

008210  K1*-K1»+K4» 

008220  GOTO  SUIJZ 

008230  CNTl :  K14-M IN ( 20 , Kl%) 

008240  J»-Kl»+5  /*  INCLUDES  "O  */ 

008250 

008  260  /*  ANOTHER  SUBSTITUTE  ?  */ 

008270 

008280  IF  STR(KEC1$,41,1)-*  *  THEN  J»-J%+2 

008290  IF  STR(REC1S, 41,11-"  "  THEN  CUT 2 

008300  K2»-0 

008310  K24-POS  (STR  (REC1$,  41,15)-"  *) 

008320  SUB1 :  IF  STR  ( REC1$,  K21M-41 , 1)  »  "  "  OR  K2*  =  15  THEN  CNT2 
008330  K44-POS  (STR (REC1$,  K24+41 , 15-K24J  -  "  *)  /*  GET  THE  REST  */ 

008  340  IF  K4»-0  THEN  K24-15  /*  THE  SUBSTITUTE  TOOK  15  SPACES  */ 

008350  K24-K24+K44 

008360  GOTO  SUB1 

008370  CNT2:  K24-MIN ( 15. K24 ) 

008  380  IF  K2%>0  THEN  K2»  -  K2*  +  3  /*  INCLUDES  */"  f.  TWO  SPACES  */ 

008390  SAVSUBL% (PHCT»J -J4+K24 

008400  SAVSUB$(PHCT»)-"<*  "  6  STR  (REC1$ ,  21 ,  Kl») 

008410  IF  K2»<>0  THEN  SAVSUBJ  ( PHCT4)  -  SAVSUBS  (PHCT4)  &  "/"  &  ! 

008420  STR(REC1$,41,K24)  &  "*>" 

0084  30  ELSE  SAVSUB$  (PHCT4)  -SAVSUBJ  (PHCT*)  &  "*>" 

008440  WSL$-"N"  /*  RESET  THE  FLAG  */ 

008450  PHCT»  -  PHCT4  +1  /*  INCREMENT  THE  COUNT  OF  WORDS  HELD  */ 

008460  GOTO  CLGW  /*  GET  THE  NEXT  WORD  */ 

008470 

008480  /*  BUILD  OUTPUT  LINE  */ 

008481 

008490  BLDOPL: 

008500  I%-1 

008510  GOSUB  SELOPT 

008520  IF  I»  <>  0  THEN  CLGW 

008530 

008540  /*  WRITE  FINAL  OUTPUT  */ 

008541 
008550  WEU: 

008560  E  O  F$-"Y"  JM 


in 
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008561  IF  UNCOM$="Y"  AND  UNCPT%  1  THEN  GOSUB  ADD_UNCWL  JM 
008570  CW$="N"  /*  NO  PHRASE  */  JM 
008580  END_0_PARJ  =  'Y"  /*  END  OF  PARAGRAPH  */  JM 
008590  I»=l  JM 
008600  GOSUB  SELOPT  JM 
008610  IF  I%-0  THEN  ENDSUB  JM 
008620  JM 
008630  /*  COMPLETE  PRINTING  THE  LAST  LINE  IF  NECESSARY  */  JM 
008640  •  JM 
008650  IF  IO%  <-  1  THEN  INTY  /*  PRINT  THE  REMAINDER  OF  LINE  */  JM 
008660  JM 
008670  GOSUB  PRTLNE  JM 
008680  IF  I%«0  THEN  ENDSUB  JM 
008690  JM 
008700  /*  CHECK  ON  NEED  POR  RGL  */  JM 
008710  /*  NO  WORDS  READ  OR  DON'T  WANT  INTERIM  RGL  */  JM 
008720  JM 
008730  INTY:  IF  WC«-0  OR  INT_ANL$0 "  Y"  THEN  CHKRGL  JM 
008740  IF  PC%-1  <=  BP%  THEN  CIRCLE  /*  NO  INTERIM  ANALYSIS  NEEDED  */  JM 
008750  GOSUB  PRTRGL  JM 
008760  IF  x Q%=»^  THEN  ENDSUB  JM 
008770  JM 
008780  IF  IOX%  =  0  OR  UNCOMSO  ”  Y“  THEN  CHKRGL  /*  NO  UNCOMMON  W ORDS*/  JM 
008790  JM 
008800  GOSUB  UWL  JM 
008810  IF  IU%«0  THEN  ENDSUB  JM 
008820  JM 
008830  /*  DO  WE  PRINT  SUMMARY  RGL  */  JM 
008840  JM 
008850  CHKRGL:  JM 
008860  IF  E_0_F$«“Y"  THEN  E_0_F$»"E"  JM 
008870  IF  E_0_FS<>  "E*  THEN  RETURN  JM 
008880  IF  UNCOMS="Y"  AND  IDX»<>0  THEN  GOSUB  UWL  JM 
008890  IF  RGLSO’Y"  THEN  RETURN  JM 
008900  LAST$*"Y"  /‘USED  TO  SET  PROPER  HEADING  ON  PRINTOUT  */  JM 
008910  IF  INT_ANL$  O'Y"  THEN  CIRCLE'  /*  NOT  BEEN  KEEPING  SUBTOTALS  */  JM 
008920  LS%»XLS%  JM 
008930  SC%-XSC%  JM 
008940  SLC%=XSLC%  JM 
008950  UW%=XUC%  JM 
008960  WC%»XWC%  JM 
008970  CIRCLE:  IF  KGL$<>"Y"  THEN  Cl  JM 
008980  LAST$-’Y"  JM 
008990  GOSUB  PRTRGL  JM 
009000  Cl:  IF  PC%-1  <“  BP%  AND  UNCOM$-*»"  AND  IDX%  <>0  THEN  GOSUB  UWL  JM 
009010  GOTO  ENDSUB  JM 
009020  JM 
009030  /******'**>'*"******“>*******************'''**•****'»***•*•****/  JM 
009040  /*  */  JM 
009050  /*  THIS  SUBROUTINE  INITIALIZES  VARIABLES  FOR  THE  ANALYSIS.  */  JM 
009060  /*  »/  JM 
009070  /»»**»**** ****************** •**•***»•*»***«»•*****»***»***»•*****/  jm 
009080  JM 
009090  SETUP:  JM 
009100  UNG$(>,  WORDS$(),  ILINE$(),  OLINE$,  SAVPH$()  =  ALL(HEX(20))  JM 
009110  PERSENT$,  END_U_PAR$,  INVLD$ ,  CW$  ,  T1$,T2$  ,  FOUNDS  ,  CLSPOSS,  T3$»"  "  JM 
009120  SF.NTP(JSS’"B-  :E  O  F$  =  "N"  JM 
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009130 

009140 

009150 

009160 

009170 

009180 

009190 

009200 

009210 

009220 

009230 

009240 

009250 

009260 

009270 

009280 

009310 

009320 

009330 

009340 

009350 

009360 

009370 

009380 

009390 

009400 

009410 

009420 

009430 

009440 

009450 

009460 

009470 

009480 

009490 

009500 

009510 

009520 

009530 

009540 

009550 

009560 

009570 

009572 

009580 

009590 

009600 

009610 

009620 

009630 

009640 

009650 

009660 

009670 

009680 

009690 

009700 


MAT  NEG4=ZER 
MAT  LCLSFL4-ZER 
UCWFLG$()="  “ 
UCW$()="  " 

IDX4-0 

CONSIST,  LISTS, 
WC»,  SCS,  SLC4 , 
WC14,WP1»  =0 
SLC14  =0 

UNCPT4, PHCT4, 104 
BEGINYS-"  1" 

LC4  =  0 
LP4-50 
LL4=77 
IL4-257 
WW4, 14-1 


:MAT  SAVPHL4-ZER  :MAT  UCWCT4-ZER 

/*  SET  LONG  CLAUSE  FLAG  TO  BLANK 
/•SET  ALL  UCW  FLAGS  TO  BLANK 
/•  SET  ALL  UCW  ARRAY  TO  BLANK 
/•  SET  THE  INDEX  TO  THE  UCW  ARRAY  TO  0 
EOS4,  PASSV4,  TPASSV4  =  0 

UW»,  LS4 ,  WS%,  PS4,  TLC4 ,  NC%,  PE»,  WP»,  SP4 


,  PC4-1 


/•  PC  IS  PAGE  COUNT 
/*  USED  POR  PRINTING  RGL 
/•  LINE  COUNT 
/*  LINES  /  PAGE 
/•  CHARS.  /  LINE 
/*  SET  SO  THAT  FIRST  LINE  WILL  BE  READ 


/•  SETUP  SUBROUTINE  RETURN 


/*********************»»***»*■>»***************»*******•**•*»»*•*• 

/*  f 

/*  THIS  SUBROUTINE  GETS  THE  NEXT  WORD  TO  BE  ANALYZED.  * 


GETWORD : 

14  =  0 

IL4-MAX(1, IL4) 

IF  IL4  >  80  THEN  GETLNE 

GET5TPOS:  /*  GET  THE  START  POSITION 

J4  =  POS  (STR(  ILINESO  ,  IL4.81-IL4)  >  *  ") 

IF  J4-0  THEN  GETLNE 


IL4  =  IL4  +  ,14  -  1 


/*  RESET  LINE  POINTER  */ 


/*  GET  END  POSITION  */ 

J4  =  POS(STR(ILINE$()  ,IL4,81-IL4)  -  "  *) 

IF  J4  <>0  THEN  FIND 

W$  =  STR(ILINE$0  ,  I L4 , 8 1  —  I L4 ) 

CR:GOSUB  GETLINE 

J4**POS  ( STR  (ILINESO  ,  IL4.Q1-IL4J  -  " 

IF  J%»1  THEN  DONE1 
IF  J4=0  THEN  CR 

WLEN4=MIN(  30..J4-1)  /•  HAD  TO  MAKE  THIS  LARGER  THAN  251 

WORDS$=STR(ILINEJ  ()  ,  IL4,WLEN4) 

WORDS$=W$  6  WORDSS 
WLEN4-LEN (WORDSS) 

GOTO  I  NCR 

DONEl:WORDS$=W$ 

WLKN4=LEN (WORDS*) 

GOTO  I NCR 
FIND: 

WLEN4 -  MIN  (  30,  J4  -  1)  /*  HAD  TO  MAKE  THIS  1ARGER  THAN  25 

WORDS*  «STR  ( I  LINES  ( )  ,  l'L4  ,  WLEN4  ) 
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009710  I  NCR:  IF  WLEN%<2  THEN  ARON  /*  CAN'T  BE  @@  */  JM 
009720  IF  WORDS$»"@@-  OR  STR(WOROS$,  1, 2)  THEN  GOSUB  ANALSKIP  JM 
009730  IF  I%  =  4  THEN  RET  /*  EOF  FOUND  */  JM 
009740  ARON:  IW%  -  MIN(5,IW%+1)  /*  RESET  POINTER  FOR  ARRAY  OF  WORDS  */  JM 
009750  IL»-IL»+J»  : LW% ( IW» ) -WL£N»  JM 
009760  JM 
009770  /*  CHECK  FOR  CARRIAGE  RETURN  (  FLAGS  END  OF  PARAGRAPH  )  */  JM 
009780  IF  STR (WORDS*, WLEN%,1)  =  HEX(03)  THEN  END_0_PAR3 - " Y "  JM 
009790  1%  »  1  /*  FLAG  A  SUCCESS  */  JM 
009800  GOTO  RET  JM 
009810  JM 
009820  /*  CALL  THE  ROUTINE  TO  GET  THE  NEXT  LINE  AND  RESET  POINTERS  */  JM 
009830  JM 
009840  GETLNE:  JM 
009850  GOSUB  GETLINE  JM 
009860  IF  I»  ■  1  THEN  GETSTPOS  JM 
009870  RET:  JM 
009880  RETURN  /*  GETWORD  SUBROUTINE  RETURN  */  JM 
009890  JM 
009900  /***•**•»*»***»*»*****»****»**»*******»**»»**********************/  JM 
009910  /*  V  JM 
009920  /*  THIS  SUBROUTINE  SKIPS  ANY  TEXT  THAT  USER  SPECIFIES  AND  DOES  */  JM 
0099  30  /*  NOT  ANALYZE  THAT  TEXT.  »/  JM 
009940  /*  */  JM 
009950  /»***»«*****«********»***»*»»»*»»«**»***»*»*»*»***»»*»***»*******/JM 
009960  JM 
009970  ANALSKIP:  /*  ANALSKIP  START  */  JM 
009980  IF  IO%FWLEN%  >  LL*  THEN  GOSUB  PRTLNS  JM 
009990  STR(OLINE*, IO*,WLEN») =WORDS$  JM 
010000  IO»-IO»+WLEN%  +  l  JM 
010010  I*=0  JM 
010020  QUIT*  =  0  /*  FLAG  TO  TELL  US  WHEN  ANOTHER  @@  HAS  BEEN  FOUND  */  JM 
010030  IL»=MAX(1,  IL%+WLEN«  +  1)  JM 
010040  IF  IL»  >  80  THEN  GETLNE1  JM 
010050  JM 
010060  GETSTPOS1 :  '  /*  GET  THE  START  POSITION  */  JM 
010061  J%“0  JM 
010062  IF  IL»>80  THEN  10080  JM 
010070  J»  =  POS(STR(  II,INK$0  ,  IL%,81-IL»)  >  *  ’)  JM 
010000  IF  J»-0  THEN  GETLNE1  JM 
010090  IL»  -  IL%  F  J4  -  1  /*  RESET  LINE  POINTER  */  JM 
010100  JM 
010110  /*  GET  END  POSITION  */  JM 
010120  J%  -  POS  (STR(ILINE$U  ,IL»,81-IL»)  »  "  ")  JM 
010130  IF  J%<>  0  THEN  FIND1  JM 
010140  WJ-STR(ILINES () ,  IL%,81-IL»)  JM 
010150  GOSUB  GETLINE  JM 
010160  J»-POS(STR(ILINE$()  ,IL»,81-IL»)  -  *  “)  JM 
010170  IF  J»*l  THEN  DONE 2  JM 
010180  WLEN%-MIN(30,J%-1)  /*  HAD  TO  MAKE  THIS  LARGER  THAN  25!  */  JM 
010190  WORDS* "STR ( I LINES ( ) , ILft , WLEN% )  JM 
010200  WORDS*  =W*  i  WORDS*  JM 
010210  WLEN»=LEN (WORDS*)  JM 
010220  GOTO  INCR1  JM 
010230  JM 
010240  DONE2:WORDSS-W*  JM 
010250  WLEN%»LEN (WORDS* )  JM 


i  v  v  v  -y  v  w  /  /wv  r-rjvwv  gTreiri^  rv  rTT^Trrr?  «  tttt*  ■,"  v 


i  % 
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010260 

010270 

010280 

010290 

010300 

010310 

010320 

010330 

010340 

010350 

010360 

010370 

010380 

010390 

010400 

010410 

010420 

010430 

010440 

010450 

010460 

010470 

010480 

010490 

010500 

010510 

010520 

010530 

010540 

010550 

010560 

010570 

010580 

010582 

010590 

010600 

010610 

010620 

010630 

010640 

010650 

010660 

010670 

010680 

010690 

010700 

<'10710 

010720 

010730 

010740 

010750 

010760 

010770 

010780 

010790 

010800 

010810 


GOTO  INCR1 
FIND1 : 

WLEN»-  MIN  (30,  J*  -  1)  /*  HA D  TO  MAKE  THIS  LARGER  THAN  25  */ 

WORDS*  =STR  ( I  LI  NE$  ( )  , I L* ,  WLEN» ) 

INCR1:  IF  QUIT4-1  THEN  RET1  /*  WE'RE  READY  TO  -SAVE  */ 

IF  IO»+WLEN»>LL»  THEN  GOSUB  PRTLNE 
STR(OLINE*,IO*,WLEN»)  “WORDS* 

IO*-IO*+WLEN»  +  l 

IL»“IL»+J*  /*  INCREMENT  LINE  POINTER  */ 

IF  STR  (WORDS*, WLEN4.1)  “HEX  (03)  THEN  GOSUB  PRTLNE/*  ENQ/PAR*/ 
IF  WLEN*<2  THEN  GETSTPOS1 

if  (woRDSJO-ee"  and  quit»=0)  or  : 

(STR(WORDS$,WL£N*-l ,  2)<>l,@@'*  AND  QUIT»=0)  THEN  GETSTPOS  l 
QUIT4-1  /*  IF  HERE,  FOUND  @0  */ 

GOTO  GETSTPOS1 

GETLNE1: 

GOSUB  GETLINE 

IF  1%  -  1  THEN  GETSTPOS 1 


RET1 :  RETURN 


/*  ANALSKIP  END  */ 


/* 


V 


/*  */ 

/*  THIS  SUBROUTINE  FILLS  THE  BUFFER  WITH  A  LINE  OF  TEXT.  */ 

/*  ...........  ....  ...  ..  .  ....  ..  .........  ....  .....  ..!/ 


/*  Assume  Success  */ 


GETLINE: 

1%,  IL*  =  1 
I LINE* ( )  -  ALL(HEX(20)  ) 

CALL  "WPREAD"  ADDR (RET* , #1, "N" , ILINE* ( ) , 80* , "L" ) 

TRAN  (  ILINE*()  .TABLE*  ()  ) 

IF  RET*  -  0  OR  RET*  -  24  THEN  GET_RET  /*  Success  */ 

IF  RET*  *  28  THEN  EOF  '  /*  EOF  */ 

PRINT  AT  (22,1);  "Error  on  WPREAD  »1"  /*  Error  */ 

I*  -  0 

GOTO  GET_RET 

EOF:  I*  -  4  /* : STOP  "FINISHED"  */ 

GET_RET: 

RETURN  /*  GETLINE  SUBROUTINE  RETURN  */ 

/...A.................*.*..........**..*............... 

/*  V 

/*  THIS  SUBROUTINE  ANALYSES  THE  WORD.  */ 

/.  */ 


/»  INCREMENT  WORDS  PER  SENTENCE  */ 


CHKWORD : 

WS»  “  WS*  +  1 
IF  CW*  <>  "P"  THEN  CW*  “ 

LEN*  -  WLEN*  :LW»(1)-LEN» 

WORD1*  “  WORDS* 

GOSUB  SPUNK  /*  STRIP  PUNC.  FROM  THE  WORD  */ 

IF  CLSPOS*  <>  "B"  THEN  SAVORGWD 
TPASSV* ,  PASS V*  -  0  JM 


z/b 


--k  ■> 


:o 

3 


.  r.  k  k  i  . 


A  . 
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010820 
010830 
010840 
010850 
010860 
010870 
010880 
010890 
010900 
010910 
010920 
010930 
010940 
010950 
010960 
010970 
010980 
010990 
011000 
011010 
011020 
011030 
011040 
011050 
011060 
011070 
011080 
011090 
011100 
01' 110 
011120 
011130 
011140 
011150 
011160 
011170 
011180 
011190 
011200 
011210 
011220 
011230 
01 1240 
011250 
011260 
011270 
011280 
011290 
011300 
011310 
011320 
011330 
011340 
011350 
011360 
011370 
011380 


SAV_ORGWD:  /*  SAVE  THE  ORIG.  WORD  FOR  UNCOM.  WORD  LIST  */  JM 

WORDO$  =  WORD1J  JM 

TRAN  (  WORDl$,  !  JM 

"  AaBbCcDdEeFf  GgHhli  J  jKkLIMraNnOoPpQqRrSsTtUuVvWwXx  Yy  Zz"  )  l  JM 
REPLACING  JM 

JM 

/*  P.  KINCAID  ASKED  FOR  THIS  PROGRAM  TO  FIND  THE  PHRASE  */  JM 
/*  1  CONSIST (S)  OF'  FOLLOWED  BY  3  COMMAS  IN  A  LONG  SENTENCE  */  JM 

/*  AND  FLAG  IT  BY  THE  TERM  'LIST?'  AFTER  THE  LONG  SENTENCE  */  JM 

/*  FLAG.  SINCE  'CONSIST(S)  OF'  IS  NOT  IN  THE  PHRASE  SUB.  */  JM 

/*  LIST,  I  USE  THE  FLAG  CONS  IS*  TO  HELP  ME  FIND  IT.  */  JM 

/*  CONSIS»«0  IMPLIES  PHRASE  NOT  FOUND;  CONSIS»«l  IMPLIES  »/  JM 

/»  PHRASE  1  CONSIST (S)  OF'  FOUND;  CONSIS4-10  IMPLIES  */  JM 

/*  *  CONSIST  (S)  '  FOUND  (NOW  LOOK  FOR  'OF');  */  JM 

JM 

IF  WORD1J  -  "OF"  AND  CONS IS*  =  10  THEN  CONSIS4-1  /*  'LIST?'  */  JM 
IF  CONSIS*“10  THEN  CONSISTS  JM 

IF  STR  (WORD1S ,  1 , 7) -’CONSIST"  THEN  CONSIS»=*10  JM 

WORD2S-WORD1S  JM 

SLASH%-POS(STR(WORDl$,l,LENS)-*/")  /*  2  WORDS  AND  A  "/"  */  JM 

IF  SLASH«»0  THEN  DOIT  /»  ONLY  ONE  WORD  */  JM 

IF  SLASH4-1  AND  LEN*=1  THEN  DOIT  /*  ONLY  ONE  SLASH  */  JM 

WRDLENS-LEN*  /»  SAVE  THE  ORIGINAL  LEN*  */  JM 

HOLD2$=STR(WORD1$,SLASH*  +  1,LEN*-SLASH%)  /*  SAVE  2ND  WORD  */  JM 

LEN%-LEN%-(LEN»-SLASH»  +  1)  /*  COMPUTE  THE  LEN  FOR  WORD  1  */  JM 

STR(WORD1S,SLASH»)=ALL(HEX(20))  /*  BLANK  OUT  2ND  WORD  */  JM 

GOTO  UOIT1  JM 

DOIT:  SLASHft  =  POS  (STR (WORD1J,  1 ,  LEN% )  JM 

IF  SLASH* -0  THEN  DOIT1  JM 

Z99$=STR(WORDlJ,l,  LEN*)  /*  CHECK  IF  SEPERATES  NUMBERS  */  JM 

A0*-POS<Z99$  =  "0")  /*  LOOK  FOR  ZERO  */  JM 

Al»-POS (Z99$="l")  /*  LOCK  FOR  ONE  */  JM 

A2*-POS(Z99$-"2")  /*  LOOK  FOR  TOO  */  JM 

A34-POS  (Z99$=’"3")  /*  LOOK  FOR  THREE  */  JM 

A4'*  =  POS  (Z99$  =  "4")  '  /*  LOOK  FOR  FOUR  */  JM 

A5»=POS <Z99$»*5")  /*  LOOK  FOR  FIVE  */  JM 

A6*“POS ( Z99$““ 6" )  /*  LOOK  FOR  SIX  */  JM 

A7%=POS(Z99$="7")  /*  LOOK  FOR  SEVEN  */  JM 

A8%"lPOS  (Z99$*"8")  /*  LOOK  FOR  EIGHT  */  JM 

A94-POS  (Z99$-"9")  /*  LOOK  POR  NINE  */  JM 

A10%*A0%+A1»+A2%+A3*+A4*+A5%+A6»+A7%+A8»+A9»  JM 

IF  A10%<>0  TiiEN  SLASH4-0  JM 

IF  LEN»-1  THEN  SLASH%"0  JM 

IF  SLASH*=0  THEN  DOIT1  JM 

WRDLEN*  =*LEN%  /*  SAVE  THE  ORIGINAL  LEN%  */  JM 

HOLD2S*STR  (WORDl$  ,SLASH%+1 ,  LEN 4 -SLASH*)  /•  SAVE  2ND  WORD  */  JM 

LEN«“LEN»-(LEN»-SLASH*  +  1)  /*  COMPUTE  THE  LEN  FOR  WORD  1  */  JM 

STR(WORI)l$, SLASH*)  “ALL(HEX  (20)  )  /»  BLANK  OUT  2ND  WORD  */  JM 

DOIT1 :  GOSUB  SYLLY  JM 

IF  SIASH*>0  THEN  ARND  /*  ONLY  1  WORD  * /  JM 

LEN*"WRDLEN* -SLASH*  /*  COMPUTE  2ND  WORD  LEN*  •/  JM 

WORD1  $ “ HOLD 2$  /*  FILL  IN  2ND  WORD  IN  VARIABLE  */  JM 

SYLCTS-TLC*  /*  SAVE  1ST  WORD  SYL.  COUNT  */  JM 

GOSUB  SYLLY  JM 

LEN*»WRDLEN*  /*  RESTORE  WORD  LENGTH  */  JM 

tlc*=tlc»+syi/;t»  /*  add  too  words'  syl  count  */  jm 


/*  COMPUTE  THE  LEN  FOR  WORD  1  */  JM 
)  )  /*  BLANK  OUT  2ND  WORD  */  JM 

JM 

/*  ONLY  1  WORD  */  JM 
/*  COMPUTE  2ND  WORD  LEN*  •/  JM 
/*  FILL  IN  2ND  WORD  IN  VARIABLE  */  JM 
/*  SAVE  1ST  WORD  SYL.  COUNT  */  JM 

JM 

/*  RESTORE  WORD  LENGTH  */  JM 
/*  ADD  TOO  WORDS'  SYL  COUNT  */  JM 
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011390 

011400 

011440 

011450 

011460 

011461 

011462 

011470 

011480 

011490 

011500 

011510 

011520 

011530 

011540 

011550 

011560 

011570 

011580 

011600 

011610 

011620 

011630 

011640 

011650 

011660 

011670 

011680 

011690 

011700 

011710 

011720 

011730 

011740 

011750 

011760 

011770 

011780 

011790 

011800 

011810 

011820 

011830 

011840 

011850 

011860 

011870 

011880 

011900 

011910 

011923 

011930 

011940 

011950 

011960 

011970 


WORD1S=,WORD2$  /*  RESTORE  THE  ORIGINAL  WORD 

ARNO: 

IF  WORD1S”"-"  OR  WORDl$-“/“  THEN  TLC4-0  /•  NO  SYLLABLES 

WW»=WW»+1  /*  KEEP  |  OF  WORDS  PROCESSED  FOR  PROGRESS  SCREEN 

IF  WW4-250  THEN  GOSUB  UPDATE  /*  REPORT  PROGRESS  TO  USER 

IF  STR(WORDOS,l,l)>«"A"  AND  STR  (WORDO$,  1 , 1)<  =  ”Z"  AND 
SENTPOS$0  "8"  THEN  SKPR 
/*  LOOK  FOR  "N'T"  */ 

IF  LEN*  <  5  THEN  LOOK 
IP  STK(WORDlS,  L£N*-2,  3)  O  "N'T" 

THEN  LOOK 

INVLDS  -  "  "  /*  WORD  OK  SO  FAR 

NEG»(H-NEG»  (3)  )  -  NEG4  ( 1+NEG*  (  3)  )  +  1 

LOOK:  /*  LOOK  UP  WORD  IN  WORD  SUBSTITUTION  LIST 

FOUNDS  -  "  * 

IF  INVLDS  ”  "Y"  OR  (INVLD$  -  "P"  AND  SENTPOS$  <>"E") 

THEN  SKPR 

RECORDS  =■  STR(WORDlS, 1,LEN*) 

TECH*  -  0 

READ  13,  KEY  -  STR(R£CORDS,  1, 20)  ,  REC1S,  EOD  GOTO  CWL 
QS  =  STR(REC1S, 56, 1) 

GOTO  SAVSUBS 

CWL:  READ  »2,  KEY  -  STR  (RECORDS ,  1 ,  20)  ,  RECORDS,  EOD  GOTO  CHEKTECH 
QS  -  STR  (RECORDS,  21,1) 

GOTO  GOOD 

CHEKTECH:  /*  SEE  IF  WORD  IS  IN  THE  SELECTED  TECH.  WORD  LISTS  */ 

FOR  J*  -  S  TO  11 

IF  TECFILS(J%-4)<>  "  *  THEN  1 

READ  #J»,  KEY  -  STR(RECORDS,  1, 20)  ,  RECORDS ,  EOD  GOTO  ANOTHA'. 
ELSE  ANOTHA 
QS  -  STR (RECORDS, 21,1) 

TECH*  =1  :  J»  =  12 

ANOTHA:  NEXT  J» 

IF  TECH*  »  0  THEN  UNCWD  ELSE  GOOD 

SKPR:  /*  INVALID  WORD,  SKIP  PROCESSING  */ 

CWS  «  "N" 

INVLDS  =  "Y" 

IF  SLASH%>-1  THEN  UNCWD  /*  "/"  OR  IN  WORD;  PUT  IN  UNCOM.  */ 

GOTO  CHKLCLS 

SAVSUBS:  /*  FOUND  WORD  IN  WORD  SUBSTITUTION  LIST*/ 

IF  NUM_SUB$-"0"  THEN  CHKLCLS  /*  NO  NEED  FOR  SUBSTITUTES  */ 

AS=*STR(RKC1$,  56, 1)  /*  FETCH  THE  PART  OF  SPEECH  */ 

WSLS-"Y"  /*  SET  FLAG  TO  FETCH  SUBSTITUTES  IN  SELOPT  */ 

RECORDS  =  STR  ( RECORDS,  1,20)  6  STR  ( REC1S ,  56,  3) 

GOTO  CHK 

UNCWD:  /*  SAVE  UNCOMMON  WORD  */ 

IF  INVLDS  -  "P"  THEN  SKPR  /*  REALLY  INVALID  */ 

IF  ABBRE4-0  THEN  SKP  /*  CHECK  IF  IN  OUR  ADBRE /MNEMONIC  LIST  */ 
POUNl-O 

FOR  QD»  =  1  TO  ABBRE* 

IF  STR(WORDl$,  1,  LEN%)>  STR(AHHRE$  (QD»)  ,  1,LEN»)  THEN  QD*«ABBRE» 

IF  STR (WORD1S ,  1 ,  LEN* )  <>  STR ( ABBRES  (QD% )  ,  1 ,  LEN4 )  THEN  DRP 


*/  JM 
JM 
•/  JM 
*/  JM 

V 


*/ 


V 


011980  IF  LEN  (ABBRES  (QD»)  )>[£N*  +  1  THEN  DRP  /‘TAKE  CARE  OF  LEN  */ 
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011990 

012000 

012010 

012020 

012030 

012040 

012050 

012060 

012070 

012080 

012090 

012100 

012110 

012120 

012130 

012140 

012150 

012160 

012170 

012180 

012190 

012200 

012210 

012220 

012230 

012240 

012250 

012260 

012270 

012280 

012290 

012300 

012310 

012320 

012330 

C12340 

012350 

012360 

012370 

012380 

012390 

012400 

012410 

012420 

012430 

012440 

012450 

012460 

012470 

012480 

012490 

012500 

012510 

012520 

012530 

012540 

012550 


FOUN4-1 

QD4-ABBRE* 

DRP:  NEXT  QD4 

IF  FOUN%=l  THEN  SKPR 

SKP :  CWS  -  "N"  /*  PHRASE  NOT  POSSIBLE  */ 

IF  INVLD$-"Y"  THEN  JUMP 
IF  UNCOMS  <>  "Y"  THEN  GOOD 

JUMP:  IF  UNCPT%<21  THEN  UNCS (UNCPT4 ) -WORDOS  /*  ROOM  FOR  20  »/ 

UNCPT»»UNCPT%+1 
IW*  *MAX  ( IW» ,  PHCT% ) 

UCWFLG$(IW%)  =  "Y" 

UW»  “  UW»  +  1  /*  COUNT  UNCOMMON  WORDS  */ 

GOTO  CHKLCLS 

GOOD:  /*  GOOD  WORD  SO  FAR,  EVALUATE  ATTRIBUTES  */ 

FOUNDS  -  "Y" 

A$  -  STR( RECORDS, 21, 1) 

CHK:  IF  (AS  -  "P"  OR  AS  -  "A"  OR  AS  »  "a*  )  AND  CLSPOSS  -  ”B“  1 

THEN  CLSPOSS  =  “Y” 

IP  AS-"V"  AND  CLSPOSS-"B"  THEN  CLSPOSS-"  Y" 

IF  CLSPOSS  =  "Y“  THEN  NC*  =  NC*  +1  /*  INC.  I  WORDS/CLAUSE  */ 

IF  AS  </  “C"  THEN  SYLC 

CLSPOSS  =  "E"  /*  SET  END  OF  CLAUSE  */ 

NEG*(1),  NEG%  (2)  ,  PASSV4,  TPASSV4  =>  0 

SYLC:  /»  CHECK  SYLLABLE  COUNT  */ 

/*  MANDATORY  TECHNICAL  WORDS  COUNT  AS  1  SYLLABLE!  */ 

IF  TECH4-1  AND  STR ( RECORDS ,  27,1)  *****  THEN  TLC4-1 

/*  WE'RE  CHECKING  FOR  'BY'  IMMEDIATELY  FOLLOWING  OR  IMMEDIATELY  */ 
/*  PRECEEDING  'TO  BE'  AND  A  PAST  PARTICIPLE.  PREV4-1  IMPLIES  */ 
/*  WE  JUST  FOUND  A  PAST  PARTICIPLE  ON  OUR  LAST  PASS  THROUGH  AND  */ 


/*  'TO  BE'  WAS  FOUND  EARLIER  IN  THE  CLAUSE  AND  IF  WE  NOW  FIND  */ 
/*  'BY*,  FULL  PASSIVE  VOICE  IS  REALIZED  (PASSV4-7).  OTHERWISE,  */ 
/*  MAKE  SURE  PREV»  IS  RESET.  LIKEWISE,  BYFLAG4-1  IMPLIES  WE  */ 
/*  HAVE  JUST  FOUND  'BY'  AND  WE’RE  NOW  LOOKING  FOR  'TO  BE'  V 
/*  IMMEDIATELY  FOLLOWING.  IF  'TO  BE'  FOUND,  SET  PASSV%  =  4  SO  */ 
/*  'TO  BE'  CODE  WILL  INCREMENT  PASSV4  TO  6  AND  ALL  WE  NEED  IS  */ 
/*  PAST  PARTICIPLE.  */ 


/*  'TO  BE'  DOESN'T  BEGIN  SENTENCES,  EXCEPT  'BE'  IMPERATIVE  */ 
IF  SENTPOS$»"B"  AND  WORDlS<>"BE"  THEN  CHKDN 

IF  PASSV$=**Y“  AND  STR  (RECORDS  ,1,3)  ="BY  “  AND  PREV4-1  ! 

THEN  PASSV4-7 

IF  PASSV$-"Y"  AND  STR (RECORDS, 24,1)“"*"  AND  8YFLAG4-1  1 

THEN  PASSV%  =  4 
PREVI,  BYFLAG4  -0 

IF  PASSV4-3  THEN  PASSV4=0  /*  'BY'  AFTER  1ST  P.  PARTICIPLE  */ 
IF  PASSVSO’Y"  THEN  CHKTPV  /*  PASSV  OPTION  NOT  ON  */ 

IF  (STR  (RECORDS,  24,1)  «  “  "  AND  STR  (RECORDS  ,12,1)“*  ")  THEN  ! 

CHKBY  /*  NO  PASSIVE  OR  TRUNCATED  PASSIVE  CHECK  */ 

/*  CHECK  FOR  PAST  PARTICIPLE  -  ELSE  DROP  TO  VERB  TO  BE  */ 

IF  STR (RECORDS, 22, 1)  -  "*■  THEN  PSTPART 
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012560  /*  VERB  TO  BE  */  JM 

012570  IF  PASSV»  -  0  OR  PASSV%  -  4  THEN  PASSV%  -  PASSV%  +  1 
012580  GOTO  CHKTPV 
012590 

012600  PSTPART:  /•  PAST  PARTICPLE  »/ 

012610  IF  PASSV*  -  1  OR  PASSV4  =>  5  THEN  PASSV%  ”  PASSV%  +  2 
012620  IF  PASSV%  -  3  THEN  PREV%  -  1  /*  SET  TO  FIND  'BY1  NEXT  */ 

012630 

012640  CHKBY :  /*  CHECK  FOR  'BY'  */ 

012650  IF  STR ( RECORDS,  1, 3)  -  "BY  "  THEN  BYFLAGi-1 
012660 

012670  CHKTPV:  IF  TRNK_PV$<>*Y"  THEN  CHKDN  /*  TRNK_PV  OPTION  NOT  ON  */ 
012680  PREV% ,  BYFLAGS  -  0 

012690  IF  ( STR ( RECORDS ,  24,1)  -  “  *  AND  STR(RECOKD$,  22, 1)  ■"  ")  THEN  ! 

012700  CHKDN  /*  NO  NEED  FOR  TRU.  PASSIVE  CHECK  */ 

012710 

012720  /*  PAST  PARTICIPLE  "/ 

012730  IF  STR (RECORDS, 22,1)  -  *•"  THEN  PSTPART1 

012740  /*  VERB  TO  BE  */ 

012750  IF  TPASSVS  -  0  THEN  TPASS V%  -  TPASSVS  +  1 
012760  GOTO  CHKDN 
012770 

012780  PSTPARTl:  /*  PAST  PARTICPLE  */ 

012790  IF  TPASSVS  *  1  THEN  TPASSVS  =  TPASSVS  +  2 
012800 

012810  CHKDN:  /*  CHECK  FOR  A  DOUBLE  NEGATIVE  */ 

012820  IF  NEGS  <>  "Y"  THEN  CNTPREP  /*  DON'T  CHECK  DOUBLE  NEG.  */ 

012830  IF  STR  (RECORDS,  23,1)  »  THEN  ! 

012840  NEGS ( 1+NEGS ( 3) )  »  NEGS (1+NEGS (3) )  +  1 

012850 

012860  CNTPREP:  /*  COUNT  PREPOSITIONS  */ 

012870  IF  PREP_CNT$  <>  “Y"  OR  STR ( RECORDS ,  2 1 , 1 )  <>  *P"  ! 

012880  THEN  CHKPS 

012890  PSS  *  PSS  +  1 
012900 

012910  CHKPS:  '/*  CHECK  FOR  PERSONAL  SENTENCES  */ 

012920  IF  PERS_S ENTS  <>  "Y"  THEN  CNTNU 

012930  IF  STR  (RECORDS,  21,1)  -  "0"  AND  STR  ( RECORDS ,  1 , 1 )  -  "Y*  l 

012940  THEN  PERSENTS  -  "Y"  /*  THE  WORD  IS  A  DERIVATIVE  OF  'YOU'  */ 

012950  IF  SENTPOSS  -  "B"  AND  STR  (RECORDS ,  21 , 1)  ■  "V*  \ 

012960  THEN  PERSENTS  -  "Y"  /*  IMPLIED  PERSONAL  SENT.  */ 

012970  IF  WORDlS  =  "I"  THEN  PERSENT$  =  " Y"  /*  1ST  PERSON  SINGULAR  */ 

012980  IF  WORDl$-"WE"  THEN  PERSENTS”"  Y“  /*  1ST  PERSON  PLURAL  */ 

012990  IF  W0RD1S-"MY"  THEN  PERSENTS*"Y"  /*  1ST  PERSON  POSSESSIVE  */ 
013000  IF  WORD  IS*  "OUR"  THEN  PERSENTS“"Y"  /*  PLURAL  POSSESSIVE  */ 

013010 
013120 

013130  /*  SEARCH  FOR  'WILL'  OR  'SHALL'  */ 

013140  IF  STR  ( RECORDS ,1,5)  ”  "WILL  "  OR  STR  (RECORDS,  1 , 6)  -  "SHALL  "  1 

013150  THEN  SETFUTR 

013160  GOTO  SETPRES 

013220 

013230  SETFUTR:  /•  SET  FUTURE  TENSE  */ 

013240  VRBT»  -  3 

013250  GOTO  CNTNU 
013260 

013270  SETPRES:  /*  SET  PRESENT  TENSE  •/  JM 
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013280 

013290 

013300 

013310 

013320 

013330 

013340 

013350 

013360 

013370 

013380 

013390 

013400 

013410 

013420 

013430 

013440 

013450 

013470 

013480 

013490 

013500 

013510 

013520 

013530 

013540 

013550 

013560 

013570 

013580 

013590 

013600 

013610 

013620 

013630 

013640 

013650 

013660 

013670 

013680 

013690 

013700 

013710 

013720 

013730 

013740 

013750 

013760 

013770 

013780 

013790 

013860 

013870 

013880 

013890 

013900 

013910 


IF  VRBT*  =  0  THEN  VRBT*  «  1 

CNTNU :  IF  PASSV$<>"Y"  THEN  CDNF1/*  CONTINUE  CHECKING,  SET  FLAGS 
IF  TRNK_PV$="Y"  THEN  CDNF1  /»  ALL  REGULAR  PV'S  ARE  TRNK  PV'S 
IF  PASSV*  <>  7  THEN  CDNF1  /*  NOT  YET 

PASSVFS  ( IW% )  -*Y"  /*  SET  FLAG 

PASSV*  =  0  /*  RESET  VALUE 

CDNF1 :  IF  TRNKPVSO’ Y*  THEN  CDNF  /*  TRUNCATED  PASSIVE  VOICE 
IF  TPASSV*  <>3  THEN  CDNF  /*  NOT  YET 

PASSVF$(IW%>  -  "Y"  /*  SET  FLAG 

TPASSV* =0  /*  RESET  TRUNCATED  PASSV  FLAG 


CDNF: 

IF  NEG*(1)  <>  2  THEN  NG 
DNFLS  ( IW»)  =  “Y* 

NEG* ( 1 )  =  0 
GOTO  CHKNOUN 


IF  NEG*  ^2)  O  2  THEN  CHKNOUN 
DNFLS  (  IW* )  -  "Y" 

NEG* (2)  =  0 

CHKNOUN : 

IF  NOUNSTR*  <  4  THEN  CHKLCLS 
NOUNFLS ( IW»)  =  “Y" 

NOUNSTR*  ■  0 


/*  CHECK  DOUBLE  NEGATIVE  FLAG 
/*  NOT  YET 
/*  SET  FLAG 
/*  CLEAR  VALUE 
/*  ONE  AT  A  TIME 


/»  NOT  HERE  EITHER 
/*  SET  FLAG 
/*  CLEAR  VALUE 

/*  CHECK  NOUN  STRING  COUNT 
/*  NOT  YET 
/*  SET  FLAG 
/*  CLEAR  VALUE 


CHKLCLS:  /*  CHK  END  OF  CLAUSE,  END  OF  SENT.  AND  LONG  CLAUSE 

IF  CLSPOSS  <>  "E"  THEN  CHK LS ENT  /*  NOT  END  OF  CLAUSE 

IF  NC»  >  10  THEN  LCLSFL»(IW»)  =  NC»  /»  SET  FLAG 

NC*  »  0 


/*  CHECK  LONG  SENTENCES  */ 


CHKLSENT: 

IF  SENTPOSS  <>  “E"  THEN  CW_RET 
IF  WS»  <  23  THEN  CHKNPR 
LSENT* ( IW%)  -  WS» 

LS*  ■■  LS*  t-  1 


CHKNPR:  /*  CHECK  FOR  TOO  MANY  PREPS 

IF  PREP_CNTS  <>  "Y"  OR  PS*  -  0  /*  DON'T  CHECK  PREPS  * 

THEN  CLEARFLDS 

J  =  WS*  *  10  /  PS*  /*  GET  RATIO 

IF  PS*  >  2  AND  J  <  54  THEN  PREPFL*(IW»)  »  PS*  /*  SET  FLAG 

CLEARFLDS:  /*  CLEAR  COUNT  FIELDS 

WS«,  PS*  -  0 

SP».  -  SP»  +  1  /*  COUNT  SENT.  /  PAR. 

SC*  »  SC*  +1  /*  COUNT  SENTENCES 

EOS»=l  /*  SET  END  OF  SENTENCE  FLAG 

IF  PERSENTS  <>  "Y"  THEN  CLRWRK  /*  NO  PERS .  SENT  FOUND 

PE*  -  PE*  +1  /»  COUNT  PERS.  SENT. 

PERSENTS  =  "  * 


CLRWRK: 

MAT  NEG*  =  ZER 


/*  CLEAR  WORK  AREA 


.  F.  V* 
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013920 

013930 

013940 

013950 

013960 

013970 

013980 

013990 

014010 

014020 

014030 

014040 

014050 

014060 

014070 

014080 

014090 

014100 

014110 

014120 

014130 

014140 

014150 

014160 

014170 

014180 

014190 

014200 

014210 

014220 

014230 

014240 

014250 

014260 

014270 

014280 

014290 

J14300 

014310 

014320 

014330 

014340 

014350 

014360 

014370 

014380 

014390 

014400 

014410 

014420 

014430 

014440 

014450 

014460 

014470 

014480 

014490 


JM 

/*  CHECK  VERB  AGREEMENT  */  JM 

IF  VRBAG4  <*  0  THEN  VRBAG4  ■  VRBT4 
IF  VRBAG4  <>  VRBT4  THEN  VRBAG4  »  -99 
VRBT4  -  0 


CW_RET: 

IF  SENTPOS$="B"  THEN  SENTPOSS-"  “  /*  OK  HERE  */ 

14  =  1  :  RETURN  /*  CHECK  WORD  SUBROUTINE  RETURN  */ 

**************************************************“************ 

/*  V 

/*  SUBROUTINE  UPDATE  KEEPS  THE  USER  ABREAST  OP  PROGRESS  OF  THE  »/ 
/*  ANALYSIS  BY  DISPLAYING  MESSAGES  OF  PROCEEDINGS  AT  THE  »/ 

/*  TERMINAL.  V 

/*  V 

/ . . . . . * . * . . . . 

UPDATE:  WW14-WW14+WW4  :WW4-0  /*  KEEP  TOTALS  */ 

IF  WW14-0  THEN  UPDMSG$«"Working . . .  Performing  CRES  Analysis..." 

IF  WW14-0  THEN  LUPE  /*  SKIP  COMPUTING  A  MESSAGE  */ 

CONVERT  Wwi 4  TO  WW1S,  PIC  ( tf  lit)  /*  CONVERT  TO  ALPHANUMERIC  */ 

LN4-LEN(WW1$)  /*  COMPUTE  THE  LENGTH  */ 

/*  DECIDE  WHICH  MESSAGE  TO  DISPLAY  TO  THE  USER  */ 

IF  STR(WW1$,  LN4-2, 3) ”"250"  THEN  UPDMSGS-  STR(WW1S, 1, LN4) • 

&  “  Words  Processed  -  ANALYSIS  Proceeding..." 


IF  STR(WWl$,LN4-2, 3) ="500"  THEN  UPDMSGS-  WW1S  &"  Words  Processed 
-  ANALYSIS  Continuing..." 

IF  STR(WWl»,LN4-2,3)="750"  THEN  UPDMSGS-  WW1$  6"  Words  Examined  - 
ANALYSIS  Proceeding..." 

IF  STR(WWl$,LN4-2,3)="000"  THEN  UPDMSGS-  WW1S  6“  Words  Analyzed  - 
ANALYSIS  Continuing. . . " 

LUPE: 

DISPLAY 

AT  (01,03) , 

"CRES:  Document  Analysis  Subsystem  (Status  of  Ana 

lysis  Screen) ", 

AT  (02,03), 


-  f  - 
AT  (12,20),  1 

UPDMSGS,  CH(  51) 

RETURN  /*  UPDATE  SUBROUTINE  END  */ 

jM 

/*  */  JM 

/*  THIS  SUBROUTINE  COUNTS  THE  SYLLABLES  IN  A  WORD.  */  JM 

/*  V  JM 

. . . .  JM 

JM 

SYLLY:  JM 

JM 

/*  CLEAR  COUNT  */  JM 

JM 
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014500 

N»=0  /*  USED  TO  COUNT 

SYLLABLES 

FROM  THE  FRONT  */ 

014510 

R»<*0  /*  USED  TO  COUNT 

SYLLABLES 

PROM  THE  REAR  */ 

014520 

M%°L£N% 

014530 

IF  LEN4-1  THEN  FINIS 

014540 

014550 

/*  CHECK  FOR  A  NUMBER  IN  THIS  WORD  */ 

014560 

014570 

Z99$-STR(W0RD1$, 1,L£N%) 

014580 

A0»“POS(Z99S="0") 

/*  LOOK  FOR  ZERO 

*/ 

014590 

Al*“POS(Z99$="l“) 

/*  LOOK  FOR  ONE 

V 

014600 

A2%-POS(Z99$="2“) 

/*  LOOK  FOR  TWO 

*/ 

014610 

A3%“POS(Z99$="3") 

/*  LOOK  FOR  THREE 

V 

014620 

A4»“POS{Z99$“"4“) 

/*  LOOK* FOR  FOUR 

V 

014630 

A5*-POS(Z99$-"5") 

/*  LOOK  FOR  FIVE 

V 

014640 

A6»“POS(Z99$="6") 

/*  LOOK  FOR  SIX 

V 

014650 

A7%“POS(Z99$=“7") 

/*  LOOK  FOR  SEVEN 

V 

014660 

A8%-POS(Z99$="8") 

/*  LOOK  FOR  EIGHT 

V 

014670 

A9»-POS(Z99S-"9") 

/*  LOOK  FOR  NINE 

V 

014680 

A10%“A0»+A1»+A2»+A3%+A4%+A5»+A6»+A7%+A8%+A9* 

014690 

IF  A10»O0  TOEN  CURVE  /* 

NUMBER  FOUND;  ONLY  1  SYLLABLE 

V 

014700 

1 

014710 

/*  set  Start  pointer  */ 

014720 

014730 

K%-1 

014740 

IF  LEN»<3  THEN  VENT 

014750 

014760 

/*  STRIP  UNUSED  ENDINGS  */ 

014770 

014780 

IF  WORD  1$=*" AREA"  OR  WORDl$“"AREAS"  THEN 

1  AREA 

014790 

014800  /* 

THESE  NEXT  TWO  ' IF'  STATEMENTS 

CATCH  WORDS  WITH  UNUSUAL  */ 

014810  /• 

ENDINGS  (LIKE  'RADIO',  'AUDIO', 

AND  SOME 

PLURALS)  AND  AID  */ 

014820  /*  THIS  SUBROUTINE  IN  CORRECTLY  COUNTING  THEIR  SYLLABLES.  */ 

014830 

rF  POS("OA“  =  STK(WORDl$,LENIi,l))>Q  AND  STR  ( HORDl$ ,  LEN*  ,  1  )<>  ! 

STH(WORDl$,LEN»-l,i)  ANU  POS  (  *  AEIOUY  '-STR  (WORD1J  ,  LEN»-2  r  1 )  )  I 
-0  AND  POS("AIOUY"-STR(WORDl$,L£N4-l,l)  )>  0  THEN  AREA 
IF  POS("OA"«STR(WORD1$,LEN»-1,1))>0  AND  STR(WORDl$,  LEN»-1,1)  t 
<>STR(WORDl$,LEN4-2, 1)  AND  POS  (  "  A£IOUY"-STR  (WORDl$,  LEN»-3, 1) )  1 
■0  AND  POS  (  "AIOU Y"=STR (WOKD1S,  LEN%-2, 1)  )  >0  AND 
STR(WORDl$,LEN», 1) -"S"  THEN  AREA 


014840 

014850 

014860 

014870 

014880 

014890 

014900 

014910 

014920 

014930 

014940 

014950 

014960 

014970 

014980 

014990 

015000 

015010 

015020 

015030 

015040 

015050 

015060 


/*  THIS  NEXT  BLOCK  OF  CODE  STRIPS  OFF  FRONT  AND  TRAILING  */ 

/*  PARTS  OF  SPECIFIC  WORDS,  AND  HELPS  US  HANDLE  THINGS  LIKE  */ 
/*  IMBEDDED  SILENT  'E'S  IN  WORDS.  */ 


VENT: IF  STR  (WORD1J,  1 , 5) 
IF  STR(WORDl$,LEN» 
IF  STR ( WORD 1S.LENV 
IF  STR ( WORDl$ , LEN% 
IF  STR(WORDl$,LEN» 
IF  STR(WORDl$,LEN% 
IF  STR (WORD1S , LEN% 
IF  STR(WORDl$,LEN« 
IF  STR (WORDl$ , LEN% 
IP  STR(W0RD1$,LEN% 
IF  STR(WORDl$, LEN% 


■"THERE"  AND  M4>  5  THEN  THES 
-3,4) “"NING"  THEN  NING 
-3,4)  “"  IALS"  THEN  MENT 
-2,3)“"DII"  THEN  AREA 
-2,3)-"ING"  THEN  THREE 
-2,3) “" IER’  THEN  TOO 
-2,  3)  ““ IOR"  THEN  THREE 
-2,3) -"IAL"  THEN  CHKD 
-2,  3) “"QUE"  THEN  QUE 
-2,3)-"GUE"  THEN  QUE 
-1,2)«"AL"  THEN  TWO 
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015070 

015080 

015090 

015100 

015110 

015120 

015130 

015140 

015150 

015160 

015170 

015180 

015190 

015200 

015210 

015220 

015230 

015240 

015250 

015260 

015270 

015280 

015290 

015300 

015310 

015320 

015330 

015340 

015350 

015360 

015370 

015380 

015390 

015400 

015410 

015420 

015430 

015440 

015450 

015460 

015470 

015480 

015490 

015500 

015510 

015520 

015530 

015540 

015550 

015560 

015570 

015580 

015590 

015600 

015610 

015620 

015630 


IF  STR(WORDl$,LEN»-l,2)="LY*  THEN  TWO 
IF  STR(W0RD1$,LEN%-1,2) =*TY"  THEN  TWO 
IF  STR(WORDl$,  LEN%-3,  4)  “"YARD"  THEN  MENT 
IF  STR  (WORD1S ,  LEN%-3,  4)  ■  "MENT"  THEN  MENT 
IF  STR(WORDl$, LEN»-4,  5)  -  "KENTS"  THEN  MENTS 

IF  STR(WORDl$,LEN»,l)  =’D"  OR  STR(WORDl$ ,  LENfe ,  1)  =  "S“  THEN  EDES 
IP  STR(WORDl$,LEN»,l)-"E"  THEN  FINALE 
GOTO  VOWEL 


QUE:  M»=M%-3  /*  STRIP  “QUE"  OR  “GUE"  FROM  END  (NO  SYLLABLES!)  */ 

GOTO  VOWEL 

AREA:  IF  STR(WORDl$,  LENI.llO'S"  THEN  M»-M»-3  ! 

ELSE  M%=M»-4  /*  HANDLES  AUDIO,  AREA,  RADIO,  ETC.  */ 

R«-R»+2 

IF  M»>1  THEN  VOWEL 
GOTO  FINIS 


/*  CHECK  FOR  CERTAIN  CONSONANTS  PRECEEDING  ,IAL"  */ 


CHKD :  Zl$=STR(WORDl$ , LEN%-3, 1) 

IF  z/j=»“D*  OR  Z1$«"N"  OR  Z1$*"R*  OR  Z1$=“V“  THEN  TWO 
GOTO  THREE 

THES:  R»-R»*l  /*  ADD  1  TO  SYLLABLE  COUNT  */ 

K»-6 

IF  M»<K4  THEN  FINIS 
GOTO  VOWEL 

TWO:  R%=R*+1  /*  ADD  1  TO  SYLLABLE  COUNT  */ 

M%-M»-2  /*  DON’T  LOOK  AT  THE  LAST  2  LETTERS  */ 

IF  M»>1  THEN  VOWEL 
GOTO  FINIS 


THREE:  R»=R*+1  /*  ADD  1  TO  SYLLABLE  COUNT  */ 

M4-M4-3  /*  DON'T  LOOK  AT  THE  LAST  3  LETTERS  */ 

IF  M%)1  THEN  VOWEL 
GOTO  FINIS 


NING:  IF  STR(WORDl$, LEN»-5, 3)  «  "ION"  THEN  THREE 

MENT:  R»=R%+1  /*  ADD  1  TO  SYLLABLE  COUNT  */ 

M%="M»-1  /*  DON'T  LOOK  AT  THE  LAST  4  LETTERS  */ 

IF  M%>  i  THEN  VCMEL 
GOTO  FINIS 


MENTS:  R%-R%  +  1  /*  ADD  1  TO  SYLLABLE  COUNT  */ 

M»=M%-5  /*  DON'T  LOOK  AT  THE  LAST  5  LETTERS  */ 

IP  M%>1  THEN  VOWEL 
GOTO  FINIS 

/*  CHECK  FOR  ED  OR  ES  */ 

EDES  :  IF  STR  (WORD1S,  LEN% -1 , 1><  )  "E"  AND  STR(WORDl$ ,  LEN%-1,  1)<>  HEX  (  2 ! 
7)  THEN  VOWEL 

IF  STR(WORDl$,  LEN%-2, 3)  “"TED"  OR  STR  (WORDiJ ,  LENU-2 ,  3)  =  “ DED"  ! 
OR  STR(WORDl$, LEN4-2, 3) ="CES"  THEN  R»=R»+1  /*ADD  A  SYL. !  V 


JM 


JM 

JM 

JM 

JM 
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015640  IF  STR(WORDl$,  LEN%-2,  3)  »"SES"  THEN  R»=R%+1  /*  ADD  A  SYL.  !  */  JM 
015650  IF  M%<4  OR  R%>0  THEN  SKEP  /*  CHECK  FOR  COMBOS  BEFORE  '  ES  ’  */  JM 
015660  IF  STR{W0RDl$,M%-l,2)O"ES*  THEN  SKEP  /*  DITTO  */  JM 
015670  Z$-STR<WORDl$,M%-3,2)  /*  SEE  IP  COMBOS.  PRECEED  "ES"  */  JM 
015680  Al»=POS(Z$=“A")  JM 
015690  A2%-POS(Z$«"I")  JM 
015700  A3»=«POS(Z$  =  "U")  JM 
015710  A4»=-POS(Z$  =  "0")  JM 
015720  A7»-A1%+A2»+A3%+A4%  JM 
015730  IF  A7»<>0  THEN  SKEP  /*  VOWEL  -  NO  MORE  SYLLABLES  */  JM 
015740  GOTO  VOWEL  /»  A  CONS.  -  ADD  A  SYLLABLE  */  JM 
015750  SKEP :  IF  STR(WORDl$,M4-l, 2)<>  "ED"  THEN  SKEP1  /*  DITTO  */  JM 
015760  IF  M%<5  OR  R%>0  THEN  SKEP1  /*  CHECK  FOR  3  CONS.  BEFORE  'ED1*/  JM 
015770  Z2$-STR(WORDl$,M%-4,3)  /*  SEE  IF  3  CONS.  PRECEED  "ED"  */  JM 
015780  Al»=POS(Z2$=*"A")  JM 
015790  A2»=POS(Z2$-*E")  JM 
015800  A34-POS (Z2$»"In)  JM 
015810  A4»=P0S(Z2$«"0")  JM 
015820  A5%=POS(Z2$*“U")  JM 
015830  A6»-POS(Z2S-"Y")  JM 
015840  A7»=A1»+A2%+A34+A4%+A5»+A6%  JM 
015850  IF  A7»O0  THEN  SKEP1  /*  VOWEL  -  NO  MORE  SYLLABLES  */  JM 
015860  R%  =  R%+1  /*  A  CONS.  -  ADD  A  SYLLABLE  */  JM 
015870  SKEPl:  M»  -  M4-2  JM 
015880  IF  M*>1  THEN  VOWEL  JM 
015890  GOTO  FINIS  JM 
015900  JM 
015910  /"  CHECK  FOR  FINAL  E,  NOT  LE  */  JM 
015920  JM 
015930  FINALE:  IF  STR (WORD1J,  LEN4-1 , 1)  -  "L"  THEN  VOWEL  JM 
015940  M%  =  M4  -1  JM 
015950  IF  M4>  1  THEN  VOWEL  JM 
015960  GOTO  FINIS  JM 
015970  JM 
015980  /*  CHECK  FOR  TRAILING  ' Y'  */  JM 
015990  -  JM 
016000  l’RAILY  :  IF  STR  (WORD1J ,  K«  ,  1)  »"  Y"  THEN  CNTSYL  JM 
016010  JM 
016020  /*  CHECK  FOR  VUWEL  */  JM 
016030  JM 
016040  VCMEL : IF  STR (WORDl$ , K* , 1) -"A"  OR  STR(WORDl$,K4, 1) -"0"  THEN  ONEXT  JM 
016050  IP  STR(WORDl$,K%,  1)  ="E"  THEN  INEXT  JM 
016060  IF  STK(WOKDl$,K4, 1)  -"I"  THEN  U_ION  .JM 
016070  IP  STR  (WORDl$  ,K4#1)  =  "0"  THEN  EORA  JM 
016080  GOTO  GETNXT  JM 
016090  JM 
016100  /*  CHECK  FOR  O  NEXT  */  JM 
016110  JM 
016120  ONEXT:  IF  K%*M%  THEN  SKIPV  JM 
016130  IF  STR(W0RD1$,K»<-1,1)  =»  "O"  THEN  CNTSYL  JM 
016140  IF  STK(WORDl$,K4+l,l)  =  "A"  THEN  CHKUA  JM 
016150  GOTO  SKIPV  JM 
016160  jM 
016170  /*  CHECK  FOR  "IJA"  WITH  A  "G"  OR  "Q"  PRECEEDING  */  JM 
016180  jM 
016190  CHKUA:  IF  STR  (WORD1S ,  K% ,  2K>  "UA"  OR  K»<2  THEN  CNTSYL  JM 
016200  IF  STR(WORDl$,K»-l,i)-"G"  OR  STR(WORDl$,K»-l,  1) »"Q"  THEN  \  JM 


•7^-7- 
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016210  SKIPV  JM 
016220  GOTO  CNTSYL  JM 
016230  JM 
016240  /*  CHECK  FOR  O  NEXT  */  JM 
016250  JM 
016260  ONEX:  IF  K»=M%  THEN  SKIPV  JM 
016270  IF  STR(W0RD1$,K%+1,1)  »  "O"  THEN  CNTSYL  JM 
016280  GOTO  SKIPV  JM 
016290  JM 
016300  /*  CHECK  FOR  I  NEXT  */  JM 
016310  JM 
016320  INEXT:  IF  K%=M%  THEN  CHKCONS  /*  CHECK  FOR  PRECEEDING  CONS.  */  JM 
016330  IF  K%»2  AND  M%>  5  THEN  DEAL  /*  SEE  IF  RE  OR  DE  IN  FRONT  */  JM 
016340  GETBAK : IF  STR (W0RD1S, K%+1 , 1)  -"I*  THEN  SKIPV  /*  CNTSYL  */  JM 
016350  GOTO  ONEX  JM 
016360  JM 
016370  /*  CODE  TO  DEAL  WITH  LEADING  RE  4  DE  */  JM 
016380  JM 
016390  DEAL:  IF  STR(WORDl$,  1 , 1)<  >  "D"  AND  STR(WORDl$ ,  1, 1)0  "R"  THEN  GETBAK  JM 
016400  Zl$-STR(WORDlS,K»+l,l)  JM 
016410  AlS»fpS(Zl$-“A“)  JM 
016420  A2»-POS(Zl$«“E"J  JM 
016430  A3%=POS(Zl$=>“I“)  JM 
016440  A44-POS (Z1$«“0“)  JM 
016450  A5»=*POS(Zl$*“U")  JM 
016460  A7»=-A1»+A2*+A3%+A4%*A5»  JM 
016470  IF  A7»>0  THEN  GETBAK  /*  NO  VOWEL  -  NOT  2  SYL. !  */  JM 
016480  N%=N*+i  /*  ADD  A  SYLLABLE  */  JM 
016490  K%»K4+1  /*  INCREMENT  PAST  “RE" ,  “DE" ,  ETC.  */  JM 


016500  GOTO  VOWEL  /*  TRY  AGAIN  */  JM 

JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
.JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 
JM 


016510 

016520 

016530 

016540 

016550 

016560 

016570 

016580 

016590 

016600 

016610 

016620 

016630 

016640 

016650 

016660 

016670 

016680 

016690 

016700 

016710 

016720 

016730 

016740 

016750 

016760 

016770 


/*  CHECK  FOR  U/ION  */ 

UION:  IF  K%»M%  THEN  SKIPV 

IF  STR (WORDl$ ,  K%  +  L ,  1) =“U“  THEN  CNTSYL 
IF  K«  +  2  >  M*  THEN  ONEXT  ' 

IF  STR(WORDl$,K%, 2)-"IA"  THEN  IA 

BACK:  IF  STR (W0RD1S , K%+1 , 1) < >  "O"  THEN  SKIPV 

IF  STR(W0KD1$,K4  +  2,1)<>  "N“  THEN  CNTSYL 
GOTO  SKIPV 

/*  CHECK  TOR  E  OK  A  */ 

EORA :  IF  K»  =  Ml  THEN  SKIPV 

IF  STR (WORD 1$ , K%  +  1 r 1 )  =“E“  THEN  CNTSYL 
GOTO  SKIPV 

/*  GET  NEXT  CHARACTER  */ 

GETNXT :  K»  =  K»+l 

IF  K»>M%  THEN  FINIS 
GOTO  TRAILY 

/*  COUNT  SYLLABLES  */ 

CNTSYL:  N*  =■  N*  +  i 
GOTO  GETNXT 


I 
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016780 

016790 

016800 

016810 

016820 

016830 

016840 

016850 

016860 

016870 

016880 

016890 

016900 

016910 

016920 

016930 

016940 

016950 

016960 

016970 

016980 

016990 

017000 

017010 

017020 

017030 

017040 

017050 

017060 

017070 

017080 

017090 

017100 

017110 

017120 

017130 

017140 

017150 

017160 

017170 

017180 

017190 

017200 

017210 

017220 

017230 

017240 

017250 

017260 

017270 

017280 

017290 

017300 

017310 

017320 

017330 

017340 


/*  SKIP  A  VOWEL  */ 

SKIPV:  K»-K%+1 

GOTO  CNTSYL 


IA: 


IF  K%<2  THEN  BACK 
IP  STR(WORDl$,K»-l,l)-"D" 
IF  STR(WORDl$,K»-l,  1) -"C" 
IF  STR(WORDl$,K%  — 1,  1)  =*“R* 
IF  STR(WORDlS,K»-l,l)-*V" 
IF  K»<3  THEN  BACK 
Z$-STR(WORDl$,K%-2,2)  /* 

Al»»POS(Z$*"A") 


/*  NO  NEED  TO  CHECK  */ 
THEN  CNTSYL 
THEN  CNTSYL 
THEN  CNTSYL 
THEN  CNTSYL 

/*  NO  NEED  TO  CHECK  */ 
SEE  IF  2  CONS.  PRECEED  " IA*  •/ 


A2S-POS (Z$-"E") 
A3»-POS(ZS-’I") 

A4I-POS (ZS-’O") 

A5«*POS(Z$  =  "U') 
A6%-POS(ZS--Y") 
A7»-A1»+A2%+A3»^A4%+A5»+A6» 


1^  A7»O0  THEN  HACK 
GOTO  CNTSYL 


/*  VOWEL  -  NO  MORE  SYLLABLES  »/ 
/*  2  CONS.  -  ADD  A  SYLLABLE  */ 


CHKCONS : 


IF  K»<3  THEN  FINIS 
Z$”STR(WORDl$,K»-2, 2) 
Al»-POS(ZS--A-) 

A2»  =  POS(Z$  =>*£“) 
A3»-POS(Zt«*I*) 
A4%-POS(Z*-*0") 
A5»-POS(Z$=’U*) 


/*  NO  NEED  TO  CHECK 
/*  SEE  IF  2  CONS.  PRECEED  "E" 


A6*=POS (Z$=’Y") 

A7»-A1»+A2»+A3»+A4%*A5%+A6» 

IF  A7»OU  THEN  FINIS  /*  VOWEL  -  NO  MORE  SYLLABLES 
N»«N»+1  /»  2  CONS.  -  ADD  A  SYLLABLE 


V 

V 


V 

V 


/*  EVEN  A  NULL  WORD  GETS  1  SYLLABLE  */ 

FINIS:  IF  N»>0  OR  K4<1  THEN  CURVE 
Z3$*STR(WOKDl$,  1  ,K4) 

Al»-POS(Z3$*’A-) 

A2«-POS(Z3$**E") 

A3»-POS(Z3$“"I") 

A4»-POS(Z3$--0-J 

A5l-POS(Z3S-"U") 

A6»=>POS  (Z3$  =  "Y'| 

A7»«A1%+A2»+A3»+A4*  <-A5»«-A6» 

IF  A7»-0  THEN  CURVE  /*  VOWEL  -  NO  MORE  SYLLABLES  •/ 

N»-l 

CURVE:  TLC%*N%+R% 

TLC%  “MAX  {  TLC%  ,  1 ) 

RETURN  /*  SYLLY  SUBROUTINE  RETURN  */ 


/ . * . * . . 

/*  V 

/*  THIS  SUBROUTINE  ADDS  A  WORD  TO  THE  UNCOMMON  WORD  LIST.  »/ 

/*  V 

/“*♦***“* . * . * . * . / 
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017350  JM 

017360  ADDJJNCWL: 

017370  UNCPT!-MIN(21,UNCPT!) 

017380  FOR  V*  -  1  TO  UNCPT!-1 

017390  POUND!  -  0  /*  RESET  FOUND  FLAG  */ 

017400  FOR  S!  -  1  TO  IDX!  /*  LOOP  TO  FIND  WORD  IN  ARRAY  */ 

017410  IF  UNC$(V!)  >  UCW$(S!)  THEN  LOOP 

017420  IF  UNC$  ( V% )  =  UCW$(S!)  THEN  INCRKM  /*  JUST  INC.  COUNT  */ 

017430 

017440  /*  WORD  SHOULD  BE  INSERTED  IN  THIS  SPOT  */ 

017450 

017460  JJ!-IDX!+1 

017470  FOR  L!-JJ!  TO  Si+1  STEP  -1 

017480  UCW$  (L!)  «UCW$  ( L%-1)  /*  MOVE  WORDS  DOWN  ONE  SLOT  */ 

017490  UCWCT! (L%) “UCWCT! (L!-l>  /»  MOVE  COUNT  ALSO  */ 

017500  NEXT  L» 

017510  UCW$  (S%)  *UNC$  (V!)  /*  PLACE  THE  WORD  IN  THE  ARRAY  */ 

017520  UCWCT! (S!)-l  /»  PLACE  THE  COUNT  IN  THE  ARRAY  */ 

017530  S!-IDX!  /*  GETS  US  OUT  OF  THE  MIDDLE  LOOP  */ 

017540  IOX!*JJ!  /*  INCREMENT  THE  INDEX  TO  THE  ARRAY  */ 

017550  FOUND! “1  /*  SET  THE  FOUND  FLAG  •/ 

017560  GOTO  LOOP 

017570  INCREMi  UCWCT! (S!) -UCWCT! (S!) +1 
017580  FOUND!»l 

017590  S!* IDX!  /«  GETS  US  OUT  OF  THE  BIG  LOOP  */ 

017600  LOOP:  NEXT  S! 

017610  IF  FOUND! *1  THEN  RETO 

017620  IDX!-IDX!+1  /*  INCREMENT  THE  INDEX  TO  THE  ARRAY  */ 

017630  UCWJ(IDX!/«UNCJ{V!>  /*  PUT  THE  WORD  AT  THE  END  */ 

017640  UCWCT!  ( IDX!) -1  /*  SET  THE  COUNT  TO  ONE  */ 

017650  RETO:  NEXT  V! 

017660  UNC$  ( )  “HEX  ( 20)  /*  RESET  BUFFER  VARIABLES  */ 

017670  UNCPT!«1 

017680  RETURN  /*  ADDUNCWL  SUBROUTINE  RETURN  */ 

017690 

017700  /****•*****************»**************»****** ********************/ 
017710  /*  */ 

017720  /*  THIS  SUBROUTINE  CHECKS  FOR  POSSIBLE  PHRASES.  */ 

017730  /*  V 

017740  /«*•*•*»**••••*»**»•***»**•»*•***•••»***•*•*•**»*•**•**•»*••****•/ 
017760  CHKPHSFL: 

017780  I!-l 

017790  K!-0 

017800  IF  CW$  =  "P"  THEN  ADD_NWD  /*  PARTIAL  PHRASE  */ 

017810  IF  CW$-’X"  THEN  RD  /»  RETRY  */ 

017820  IP  SENTPOS$-"E"  OR  CLSPOS*-’E"  THEN  CHKNWDS  /*NO  POSS.  PH.  •/ 

017840  IP!-l 

017850  WORDP$-ALL(HEX(20)  )  /*  BLANK  OUT  OUR  PHRASE  BUFFER  */ 

017860  SAVPHi  STR(WORDP$, IP!, LEN!) -WORD1J 
017870  IP!-IP!+L£N! 

017880  RD:  READ  #4,  KEY  >  -  STR(WORDP$ ,  1 ,  IP!)  ,  PRECJ ,  EOD  GOTO  CHKNUM2 

017890  IF  STR(WORDP$, 1, IP!)  <>  STR(PRKC$, 1, IP!)  THEN  CHKNUM2 

017900 

017910  /•  WE  MUST  HAVE  A  POSSIBLE  PARTIAL  PHRASE  */ 

017920 

0179.0  CWJ-'P’ 

017940  GOTO  PHRS  RET  JM 
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017950 
017960 
017970 
017980 
017990 
018000 
018010 
018020 
018030 
018040 
018050 
018060 
018070 
018080 
018090 
018100 
018110 
018120 
018130 
018140 
018150 
018160 
018170 
018180 
018190 
018200 
018210 
018220 
018230 
018240 
018250 
018260 
018270 
018280 
018290 
018300 
018310 
018320 
018  330 
018340 
018350 
018360 
018370 
018380 
018390 
018400 
018410 
018420 
018430 
018440 
018450 
018460 
018470 
018480 
018490 
018600 
018510 


IF  <IP4  +  LEN%)>23  THEN  SWTCH 
STR(WORDP$,  I P%  +  1 ,  LEN% )  -WOROIJ 
IP»-IP»+LEN»+1 

READ  14,  KEY >=  STR(WORDP$ , 1 , IP»)  , PREC$, EOD  GOTO  CHOP 
/*  LET'S  SEE  IF  THE  FIRST  PART  HATCHES  »/ 

IF  STR(WORDP$,l,IP»)<>  STR(PR£C$,1,IP»)  THEN  CHOP 
/»  LET’S  SEE  IF  THE  WHOLE  PHRASE  MATCHES  »/ 

IF  STR (WORDP$, 1,24)  =STR( PREC$ ,1,24)  THEN  SUCCESS 
/*  DO  WE  KEEP  LOOKING?  */ 

IF  IW4  =  5  THEN  CHOP 

IF  SENTPOSJ  -  "E"  OR  CLSPOSS-’E"  THEN  CHKNWDS 
GOTO  PHRS_RET 
SUCCESS: 

CW$«“Y’  /*  WE  FOUND  ONE  -  SET  FLAG  */ 

GOTO  PHRS_RET 

CHKNWDS: 

IF  IW4  <  3  THEN  FAIL 
GOTO  SWTCH 


IF  IW4  *  1  THEN  FAIL  /*  IF  HERE,  NO  MATCH  */ 

GOTO  CHOP 

SWTCH:  K»  *  -1 

CHOP:  CW$  =  "X*  /*  CHOP  OFF  LEADING  WORD  -  X  MEANS  RETRY  */ 

1%  -  1 

1)4  =  3  '  /*  PRINT  WORDS  AND  FLAGS  ONLY 

GOSUB  PRTWDS 

IF  14  =  0  THEN  PHKS_KET 

J4"POS(5TR(WORDP$,l,24)="  “)  /*  FIND  THE  FIRST  BLANK  */ 
WORDP$=STR(WORDP$,  J4  +  1)  /*  CHOP  OFF  1ST  WORD  •/ 

IP4-IP4-J4  /* : 1W4 ■ IW4 - 1  */  /*  ADJUST  BUFFER  PTR.  */ 

IF  K4=0  THEN  RD 
GOTO  SAVPH 

FAIL:  CW$-"N*  /*  NO  PHRASE  -  SET  FLAG  */ 

p HRS  RET: 

RETURN  /•  CHKPHSPL  SUBROUTINE  RETURN  */ 


/•  THIS  SUBROUTINE  SELECTS  A  LINE  TO  PRINT. 


04-1  /*  ASSUME  SUCCESS  */ 

/•  SELECT  THE  WAY  TO  GO  */ 


Technical  Report  86-001 


Wang  VS  Integrated  Editor  -  Version  6.10.00  13:49  12/14/84  Page  33 
Input  File  is  ANALYSIS  in  Library  CRES@SRC  on  Volume  CRES01 

018520  JM 
018530  IF  CWS-"Y"  THEN  FORTY  /*  PHRASE  */  JM 
018540  IF  WSL$-"Y"  THEN  THIRTY8  /*  WORD  SUBSTITUTES  */  JM 
018550  JM 
018560  /*  IF  NONE  OF  THE  ABOVE,  PRINT  WORDS  */  JM 
018570  JM 
018580  GOSUB  PRNT_WDS  JM 
018590  GOTO  OUTS  JM 
018600  JM 
018610  /*  SET  UP  DATA  SO  WORD  SUBS.  CAN  BE  FETCHED  USING  PHRASE  CODE  */  JM 
018620  JM 
018630  THIRTY8:  IF  PHCT4-1  THEN  THIRTY9  /*  DON'T  FORGET  ANY  WORDS  */  JM 
018640  JM 
018650  /*  INCLUDE  WORDS  SAVED  FOR  POSSIBLE  PHRASE  BEFORE  */  JM 
018660  /*  IS  THERE  ROOM  ON  THE  OUTPUT  LINE?  •/  JM 
018670  JM 
018680  FOR  I%-1  TO  PHCT»-1  JM 
018690  IF  IO»  +  SAVPHL*  ( 1%)  +  SAVSUBL* (I»)  >  LL»  THEN  GOSUB  PRTLNE  JM 
018700  IF  PPLAG»-0  THEN  OUTS  JM 
018710  IF  SAVSUBL* ( I* )«0  THEN  \  JM 
018720  STI}(OLINE$,  IO», SAVPHL* ( I»)  )  -STR  (SAVPH$  ( I»)  ,  1  ,SAVPHL%  ( 1%)  )  JM 
018730  ELSE  STR (OLINEJ ,  104 , SAVPHL4 (It) +SAVSUBL* ( 16) )  -  «  !  JM 
018740  STR(SAVPH*(I»)  ,1, SAVPHL*  (I»)  )  k  *>*  k  '.  JM 
018750  STR(SAVSUBJ(I») , 1, SAVSUBL* ( 1%) -2)  JM 
018760  WC1»«WC1»+1  /*  INCREMENT  THE  WORD  COUNT  */  JM 
018770  WP1»*WPI»+1  /*  INCREMENT  THE  WORDS  PER  PARAGRAPH  COUNT  */  JM 
018780  SLC1»-SLC1*+SAVSYL»  (1%)  /*  INCREMENT  SYLLABLE  COUNT  »/  JM 
018810  IO» -SAVPHL* ( I* )  ♦  IO»  +  1  +  SAVSUBL* (I»)  JM 
018820  IF  SAVSUBL* C I % ) <> 0  THEN  SAVSUBL* (I* ) -0  JM 
018830  NEXT  I*  JM 
018840  PHCT*  -  1  JM 
018850  THIRTY9:  PKECS-ALL (HEX ( 20) )  /*  SET  UP  PRECS  WITH  WORD  SUBS.  */  JM 
018860  STR(PKEC$,1,20)*STR(REC1S,1,20)  JM 
018870  STH ( PRECS, 25) "STR ( REC1$, 21 ,20)  JM 
018880  STR(PRECS,45)-STR(REC1S,41,15)  JM 
018890  WSLS*"N"  '  /*  RESET  THE  FLAG  */  JM 
018900  JM 
018910  /*  PRINT  A  PHRASE  AND  SUBSTITUTES  k  SET  DEFAULTS  »/  JM 
018920  JM 
018930  FORTY:  IF  CWS-"Y"  THEN  MAT  SAVSUBL*  -  ZER  /*  CLEAR  WORD  SUBS.  */  JM 
018940  J»*0  JM 
018950  Kl*-U  JM 
018960  K2»-0  JM 
018970  K3»-l  JM 
018980  JM 
018990  /•  COMPUTE  THE  LENGTH  OF  PHRASE  AND  SUBSTITUTES  */  JM 
019000  /•  FIRST,  GET  THE  LENGTH  OF  PHRASE  */  JM 
019010  JM 
019020  IF  PHCT* *1  THEN  SKPTHS  JM 
019030  FOR  I*  =  l  TO  PHCT*  -1  JM 
019040  J%  ■  J*  +-SAVPHL*  ( I » )  +1  /*  INCLUDE  SPACES  */  JM 
019050  NEXT  I*  JM 
019060  SKPTHS:  IF  STR ( PRECS , 25, 1 ) -  *  “  THEN  BLANKS*" Y"  /"NO  SUBS.  */  JM 
019070  IF  BLANKS*" Y"  THEN  J*-J»+WLEN»  /*  DON'T  FLAG  THE  PHRASE  */'.  JM 
019080  ELSE  J»*J**2+WLEN*  /*  INCLUDES  LAST  WORD  AND  <•  .  .>  */  JM 
019090  JM 
019100  /*  CHECK  ON  NUMBER  OF  SUBSTITUTES  TO  PRINT  */  JM 


/ay 
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019110 

019120 

019130 

019140 

019150 

019160 

019170 

019180 

019190 

019200 

019210 

019220 

019230 

019240 

019250 

019260 

019270 

019280 

019290 

019300 

019310 

019320 

019330 

019340 

019350 

019360 

019380 

019390 

019400 

019410 

019420 

019430 

019440 

019450 

019460 

019470 

019480 

019490 

019500 

019510 

019520 

019530 

019540 

019550 

019560 

019570 

019580 

019590 

019620 

019630 

019640 

019650 

019660 

019670 

019680 

019690 

019700 


IP  NUM_SUB$-"0"  OR  STR(PR£CS,25,1)»"  "  THEN  FORTY 2  /‘NONE  */ 
/•  GET  LENGTH  OF  SUBSTITUTE  |1  •/ 

Kl»  —  1 

K14-POS (STR(PKEC$, 25,20)""  *) 

OVA:  IF  STR(PRECS,K14+25,1)-*  ’  OR  K14-20  THEN  COUNT 

K44-POS  (STR ! PRECS , K14+25,  20 -KH)  "*  ’)  /*  GET  THE  REST  */ 

IF  K44-0  THEN  K14-20  /‘THE  SUBSTITUTE  TOOK  20  SPACES*/ 

K14-K14+K44 
GOTO  OVA 

COUNT:  K14=»MIN(20,K14) 

J4-J4+K14+5  /*  INCLUDES  *<*  * _ **>*  */ 

/»  ANOTHER  SUBSTITUTE  ?  */ 

IF  STR  ( PRECS ,45,1)-"  *  THEN  FORTY 2 
K2»— 1 

K24-POS(STR(PRECS,45,  20)-*  *) 

OVA1 :  IF  STR(PREC$,K24<-45,  1)  »"  *  OR  K2%  =  20  THEN  COUNT1 

K44-POS (STR(PRECS,K24+45,  20-K24) «"  *)  /*  GET  THE  REST  */ 

IF  K44-0  THEN  K24-20  /*  THE  SUBSTITUTE  TOOK  20  SPACES  •/ 

K24-K24+K44 
GOTO  OVA l 

COUNT1:  K24-MIN(20,K24) 


J4-J4+K24+3 


/•  INCLUDES  */■  i  WO  SPACES  */ 


/*  PRINT  THE  PHRASE  */ 

FORTY 2 :  PFLAG4  «  K34 

IF  104  +  J4  >  LL4  THEN  GOSUB  PRTLNE 
IF  PFLAG4-0  THEN  OUTS 
IF  BLANK$="Y"  THEN  MISS 
STR (OLINES, 104, 1) =  *<“  ' 

I04-I04U 

/*  INSERT  THE  PHRASE  */ 

MISS :SAVPH$ (PHCT4) -WORDS* 

SAVPHL4 ( PHCT4 ) -WLEN4 
SAVSYL4 (PHCT4) -TLC4 
FOR  14-1  TO  PHCT4 

STR (OLINES,  104  ,  SAVPHL4  ( 14 )  )  -STR(SAVPHS (14)  ,  1 ,  SAVPHL4  ( 14)  ) 
WC14-WC14+1  /*  INCREMENT  THE  WORD  COUNT  */ 

WP14-WP14+1  /*  INCREMENT  THE  WORDS  PER  PAR.  COUNT  */ 

SLC14-SLC14+SAVSYL4 ( 14) /*  INCREMENT  THE  SYLLABLE  COUNT  */ 
I04-I04+SAVPHL4 ( 14)  +1  /•  INCLUDE  SPACES  */ 

NEXT  14 

IF  BLANKSO’Y"  THEN  I04-I04-1  /*  EXCEPT  THE  LAST  ONE  */ 

PHCT4-1  /*  RESET  PARTIAL  PHRASE  COUNT  */ 

/*  INSERT  SUBSTITUTES  */ 

IF  BLANKS-’Y"  THEN  FIFTY 
STR(OLINE$, 104, 1) «">' 


290 
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019710  104=104+1  JM 

019720  IF  NUM_SUB$-“0"  THEN  FIFTY  /*  NO  SUBSTITUTES  */  JM 

019730  STR(OLINE$,  104, 2)  =■’<*■  JM 

019740  I04-I04+3  /*  INCLUDE  A  SPACE  */  JM 

019750  IF  K14-0  THEN  FORTY 4  /*  NO  SUBST.  IN  PHRASE  SUB.  LIST  •/  JM 

019760  STR (OLI NK$ , 104, K14) =STR (PR£C$ , 25, K14)  JM 

019770  I04-I04+K14  JM 

019780  IF  K24-0  THEN  FORTY 4  JM 

019790  STR(OLINE$, 104,1) «*/* 

019800  I04-I04+2  /*  INCLUDE  A  SPACE  */ 

019810  STR(OLINE4, 104 , K24) -STR (PRECJ , 4 5 , K24 ) 

019820  I04-I04+K24 

019830 

019840  /*  FINISH  THE  ENTRY  */ 

019850 

019860  PORTY4 :  STR (OLINE$ , 104 , 2) =’*>” 

019870  I04-I04+2 

019880 

019890  /•  NOW  PRINT  ANY  FLAGS  FOR  THE  WORDS  IN  THE  PHRASE  */ 

019900 

019910  FIFTY:  BLANKS* "N" 

019920  D4  =  2 

019930  GOSUB  PRNT_WDS 

0 19940 

019950  OUTS:  RETURN  /*  SELOPT  SUB.  RETURN  */ 

019960 

0199  70  /***•»•**•***•••+••«+****•*******«**•**»*»**••»******+*•*********/ 

019980  ./»  V 

019990  /•  THIS  SUBROUTINE  PRINTS  A  LINE  TO  THE  PRINT  FILE.  »/ 

020000  /*  */ 

020010  /*»**•••*******••******++*+******»******+**»**•*•*****•****»•••«*/ 

020020 

020030  PRTLNE : 

020040 

020050  IF  E_0_F$-"E*  THEN  FINISH 

020060 

020070  IF  1 114*0  AND  PC4-1  THEN  GOSUB  TOPI 

020080  C$  *  HEX (0001) 

020090  WRITE  112,  USING  Y,  CS 

020100  WRITE  |12,  USING  X,  C$ ,  OLINES 

0  20  1  1  0  OLI NE$  =  ALL  (  HEX  (  20)  ) 

020120  104  -  1 

0201  30  LC4  -  LC4  +  2 

020140  IP  LC4<-LP4  THEN  FINAL  /*  NO  NEED  FOR  RGL  YET  */ 

020150  LC4-P  /*  RESET  LINE  COUNT  »/ 

020160  IF  PC4<-GP4  THEN  TEN  /*  IS  IT  TIME  FOR  INTERIM  ANALYSIS?  */ 

020170  GP4  -  GP4  +  DP4  /*  RESET  GP4  FOR  NEXT  BREAK  POINT  */ 

020180  IF  INT_ANL$<>*Y"  THEN  CHKUCW 

020190  GOSUB  PRTRGL  /*  PRINT  INTERIM  ANALYSIS  */ 

020200  GOTO  CHKUCW 

020210  FINISH:  IF  RGL4  <>  *Y*  THEN  CHKUCW  /*  SHOULD  WE  PRINT  RGL?  */ 

020220  GOSUB  PRTRGL 

020230  CHKUCW: 

020240  IF  IDX4  *  0  OR  UNCOMJ<?"Y"  THEN  TEN  /*  NO  UNCOMMON  WORDS  */ 

02025U  GOSUB  UWL  /*  PRINT  UNCOMMON  WORD  LIST  */ 

020260  IF  E  O  F*-“E“  THEN  FINAL 

020270  TEN:  GOSUB  TOPI  /*  PRINT  TOP  OF  PAGE  */ 
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020280  GOTO  PINAL  JM 
020290  TOPI:  GOSUB  TOP  JM 
020300  WRITE  #12, USING  ZZZ,CS.PC%  JM 
020310  PC»-PC%+1  JM 
020320  RETURN  JM 
020330  X : %##  »«»#»# »!»»««»•#•  ###»»»#l#lll#####»Mi#»# ###«## ttltl IMt »# II JM 
020340  lllllllllltlllllll  JM 
020350  Y: %!#  JM 
020360  ZZZ : %! #  I  JM 
020370  PAGE  III  JM 
020380  FINAL:  JM 
020390  RETURN  /*  PRTLNE  SUB.  RETURN  */  JM 
020395  JM 
020420  /**•*•**•*»******•••*•**»«»»*••»*****»**•«••*»»•»•»*»•**•»••**•*•/  JM 
020430  /*  V  JM 
020440  /*  THIS  SUBROUTINE  PRINTS  THE  READING  GRADE  LEVEL.  •/  JM 
020450  /*  V  JM 
020460  /*«»*»***»»**********•******»*»***********»*»*»»****»»**»»»**»»*»/  JM 
020470  JM 
020480  PRTRGL:  JM 
020490  IQ4-1  /»  SUCCESS  FLAG  */  JM 
020500  WC4=MAX(WC»,1)  /*  AT  LEAST  ONE  WORD  •/  JM 
020510  SC»-MAX(SC»,  1)  /»  AT  LEAST  ONE  SENTENCE  */  JM 
020520  JM 
020530  /*  KEEP  OVERALL  TOTALS  */  JM 
020540  JM 
020560  XWC»-XWC»*WC%  /»  WORD  COUNT  TOTAL  */  JM 
020570  XSC»"XSC»+SC»  /*  SENTENCE  COUNT  TOTAL  */  JM 
020580  XSLC%=*XSLC»+SLC»  /*  SYLLABLE  COUNT  TOTAL  */  JM 
020590  XUC4-XUC4+UW4  /*  UNCOMMON  WORD  TOTAL  •/  JM 
020600  XLS4-XLS4  +  LS4  /*  LONG  SENTENCE  TOTAL  */  JM 
020610  JM 
020620  SLC  -  SLC»  :  WC  «  WC»  :SC  -  SC»  JM 
020630  NSW-SLC/WC  /*  NUMBER  SYLLABLES  PER  WORD  */  JM 
020640  NWS=WC/SC  /*  NUMBER  WORDS  PER  SENTENCE  */  JM 
020650  '  JM 
020660  RGL"  ( NWS*  .  39)  +  (NSW*  11 . 8)  -15.59  /*  COMPUTE  READING  LEVEL  */  JM 
020670  F1-UW4  /*  PERCENT  OF  UNCOMMON  WORDS  •/  JM 
020680  F 2  =  LS 4  /*  PERCENT  OF  LONG  SENTENCES  •/  JM 
020690  IF  Pl>  0  THEN  P1-F1/WC4*  100  JM 
020700  IF  F2>0  THEN  F2-F2/SC4*  100  JM 
020710  JM 
020720  /*  LET'S  COMPUTE  HEADER  INFORMATION  */  JM 
020730  JM 
020740  IF  LASTS"" Y"  THEN  BUPPER$""PINAL  ANALYSIS"  JM 
020750  IF  LASTS"" Y"  THEN  JAPAN  JM 
020760  CONVERT  PC4-1  TO  ENDYS,  PIC  ( 1 1 1)  JM 
020770  BUFFERS- "INTERIM  ANALYSIS  (PAGES  *  i  BEGINYS  t  "  -"  &  ENDYSfc" )  "  JM 
020790  JM 
020800  /*  NOW  LET'S  WRITE  THIS  INFORMATION  OUT  */  JM 
020810  JM 
020820  JAPAN:  GOSUB  TOP  JM 
020830  WRITE  #12,  USING  H,  CS  /*  SKIP  ONE  LINE  */  JM 
020840  IF  I,ASTS3"Y"  THEN  WRITE  |12, USING  RQ,C$ ,  BUFFERS  !  JM 
020850  ELSE  WRITE  112,  USING  RG,  CS,  BUFFERS  JM 
020860  WRITE  |12,  USING  H,  CS  /*  SKIP  ONE  LINE  */  JM 
020870  WRITE  #12,  USING  RR,  CS  /*  PRINT  "READIBILITY  RESULTS’  */  JM 
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020880  WRITE  #12,  USING  H,  CS  /*  SKIP  ONE  LINE  */  JM 

020890  WRITE  #12,  USING  H2,  CS  /*  PRINT  HEADING  */  JM 


020900  WRITE  #12,  USING  H3,  CS ,  SC4,  WC» ,  SLC»  /*  PRINT  DATA  */  JM 
020910  WRITE  #12,  USING  II,  CS  /*  SKIP  ONE  LINE  */  JM 
020920  WRITE  #12,  USING  H4,  CS/*  AVG.  WORD/SENT,  it  SYL/WORD  HEAD.*/  JM 
020930  WHITE  #12,  USING  H5,  CS,  NWS,  NSW  /*  PRINT  DATA  */  JM 
020940  WRITE  #12,  USING  H,  CS  /»  SKIP  ONE  LINE  */  JM 
020950  IF  UNCOMSO* Y"  OR  LNGSENSO"  Y“  THEN  JUMPY  JM 
020960  WRITE  #12,  USING  H6,  CS  /*  %  OP  UW'S  6  »  LONG  SENT.  HEAD.  */  JM 
020970  IF  F2-100  THEN  WRITE  #12,  USING  H9,  CS,  FI,  F2  !  JM 
020980  EI2JE  WRITE  #12,  USING  H7,  CS,  FI,  F2  /•  *  OP  UW'S  &  6  LS  */  JM 
020990  GOTO  JUMP 2  JM 
021000  JUMPY:  IF  UNCOMSO’Y*  THEN  JUMP1  JM 
021010  WRITE  #12,  USING  Al,  CS  /*  4  OF  UW'S  HEADING  ONLY  */  JM 
021020  WRITE  #12,  USING  A2,  CS ,  FI  /*  %  OF  UW'S  */  JM 
021030  GOTO  JUMP2  JM 
021040  JUMP1:  IF  LNGSENSO*  Y"  THEN  JUMP 3  JM 
021050  WRITE  #12,  USING  Bl,  CS  /*  »  LONG  SENT.  HEAD.  ONLY  */  JM 
021060  IF  F2«100  THEN  WRITE  #12,  USING  A3,  CS,  F2  1  JM 
021070  ELSE  WRITE  #12,  USING  A2,  CS,  F2  /*  »  LS  ♦/  JM 
021080  JUMP2 : WR ITIj  #12,  USING  H,  CS  /*  SKIP  ONE  LINE  */  JM 
021090  JUMP3 :WRITE  #12,  USING  H8,  C$,RGL  /*  PRINT  RGL  */  JM 
021100  GOTO  JAKE  JM 
021110  Al:%t#  Percent  of  Uncommon  Word:;  JM 
021120  Hl:%t#  Percent  of  Long  Sentences  JM 
0211  30  A  2 : %  #  #  tl.tt  JM 
021140  A3 : % t #  ft*.##  JM 

021150  RR:»#»  -  READABILITY  RESULTS  - !  JM 

021160  -  JM 

021170  RQ:»I#  t ( t I t I t I t ( « t I I ( ( t ( t « I t « # t I t • t I t )  JM 
021180  RG : % t <  •##•##»#»#«#######•####•#(#(####*  JM 
021190  H :  %#  #  JM 
021200  H2:4tl  Number  of  Sentences  Number  of  Words  Number  of  !  JM 
021210  Syllables  JM 
021220  H3:«t»  tttitt  ttltlt  #•<«:  JM 
021230  #»  '  JM 
021240  H4:4tl  Avg.  Number  of  Words  per  Sentence  Avg.  Number  of  Sylla!  JM 
021250  blen  per  Word  JM 
021260  H5:«tt  fit#.##  ##(#!  JM 
021270  .«#  JM 
021280  H6:6##  Percent  of  Uncommon  Words  Percent  of  Long  Sent!  JM 
021290  ences  JM 
021300  H7:»tt  #(.##  ft. ft  JM 
021310  H9 : 4  #  #  tl.tt  It#.##  JM 
021320  H8:t|#  GRADE  LEVEL  (Uased  on  DoD  Readability  Standard)  ■  ##.#♦  JM 
021330  JAKE:  /*  CLEAR  ALL  VARIABLES  FOR  NEXT  PART  OF  ANALYSIS  */  JM 
021340  JM 
021350  CONVER  T  PC"*  TO  BEG  I NYS,  PIC  ( 1 1 »)  /*  READY  FOR  NEXT  TIME  */  JM 
021360  UW1,WC4,SC»,SIX-4,LS4  =  0  JM 
021  370  RETURN  /*  PRTRGL  SUB.  RETURN  */  JM 
021380  JM 
021390  /****************************************•***********************/  JM 
021400  /*  */  JM 
021410  /*  SUBROUTINE  TOP  PRINTS  A  CENTERED  TITLE  AT  THE  TOP  OF  THE  */  JM 
021420  /*  PAGE.  */  JM 
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021450  JM 

021460  TOP: 

021470  C$-HEX (8001) 

021480  WRITE  112,  USING  H,  CS  /*  GET  TO  TOP  OP  FORM  */ 

021490  LC»-0 

021500  C$-HEX(0001) 

021510  IF  PAG_TITLS-"  *  THEN  NERF 

021520  WRITE  *12,  USING  X,  CS,  TITLBUPS 

021560  NERP: RETURN  /*  SUBROUTINE  TOP  RETURN  •/ 

021570  /»»•**•***••**•**••**•«*••»»»»**••*»*****»*»*************»*******/ 

021580  /*  V 

021590  /»  THIS  SUBROUTINE  PRINTS  THE  UNCOMMON  WORD  LIST.  */ 

021600  /*  V 

021610  /*******«»*»***»*«**********»*»****»*****»»»»»»»**•»*••*•**»••»*•/ 

021620 
021630  UWL: 

021640  IU4-1 

021650  IF  IDX4-0  THEN  NINETY  /*  NO  WORDS  IN  UCWS  */ 

021660 

021670  /*  SET  UP  FOR  THE  FIRST  PAGE  OF  PRINTOUT  */ 

021680  , 

021690  GOSUB  TOP 

021700  WRITE  #12,  USING  H,  C$ 

021701  OVER:  CS-HEX(OOOl) 

021710  WRITE  #12,  USING  HEAD,  C$  /*  PRINT  UCW  HEADING  */ 

021720  WRITE  #12,  USING  HEAD1,  CS  /*  PRINT  *  WORD  *  ,  •  FREQ  ’  HEADING  */ 

021730  J4-100  /*  MAXIMUM  PER  PAGE  */ 

021740  IF  IDX»<J*  THEN  J4-IDX4  /*  IF  #  100  */ 

021750  IDX%=*  IDX4-J4  /*  RESEr  INDEX  COUNT  FOR  LATER  */ 

021760  K4-J4/2  /*  NUMBER  OF  WORDS  PER  COL.  •/ 

021770  IF  (J»>2*K4)  THEN  K4=K4+1  /*  ODD  NUMBER  OF  WORDS  */ 

021780  C$»HEX(0001J 

021790  IF  K%=1  THEN  SKIPIT 

021800  FOR  DL4-1  TO  K»-l 

021810  WRITE  #12,  USING  UCWFMT, C$ ,  UCWS  (DL4)  ,UCWCT»  (DL* )  ,  ! 

021820  UCWS (K4  +  QL4 ) , 0CWCT» (K4+DL4) 

021830  NEXT  DL4 

021840  SKIPIT: 

021850  K4-J4/2  /«  LET'S  SEE  WHAT  WE  SHOULD  DO  FOR  THE  LAST  LINE  */ 

021860  IF  (J»>2*K»)  THEN  WRITE  #12,  USING  UCWFM1,  C$,  UCWS(K%+1),  ' 

021870  UCWCT»(K»+1)  ! 

021880  ELSE  WRITE  #12,  USING  UCWFMT,  C$,  UCW$(K%),  UCWCT4 <K%> ,  ! 

021890  UCWS (J»J ,UCWCT» (J») 

021900  IF  IDX4-0  THEN  FINICH 

021901  FOR  OL4-14  TO  10X4 

021902  UCWS (DL») -UCWS (DL4+1004) 

021903  UCWCT4 (DL4) -UCWCT4 (DL4+1004) 

021904  NEXT  DL4 

021910  CS-HEX (8001) 

021920  WRITE  #12,  USING  H,  CS 

021930  GOTO  OVER 

021940  UCWFMT:###  #»###•#»#•«##»«• #*«•  t»  »*•»»««###•#•##((»»#: 

021950  ## 


021960  UCWFM1 : %##  »«>>###(#«•(#»##»(#(  »» 

021970  HEAD : % # #  -  UNCOMMON  WORDS 


021980  - 

021990  HEADl : % # #  WORD  FREtf 


:  JM 


WORD 
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022000 

FREQ 

JM 

022010 

FINICU:  MAT  UCWCT4-  2ER 

/*  ZERO  OUT  ALL  COUNTS 

*/ 

JM 

022020 

INITC  •)UCW$() 

/*  8 LANK  OUT  OLD  UNCOMMON  LIST 

*/ 

JM 

022030 

JM 

022040 

NINETY: 

JM 

022050 

RETURN 

/*  UWL  SUBROUTINE  RETURN 

*/ 

JM 

022060 

JM 

022070 

'*/ 

JM 

022080 

/* 

*/ 

JM 

022090 

/*  THIS  SUBROUTINE  STRIPS  PUNCTUATION  FOR  THE  WORD  WORD1J. 

V 

jm 

022100 

/* 

♦/ 

JM 

022110 

-*/ 

JM 

022120 

JM 

022130 

SPUNK: 

JM 

022140 

BSS-SENTPOSS  :  BCS-CLSPOSS 

:  BBS-"  " 

JM 

022150 

FOUN lB0 

/*  WE  HAVEN'T  FOUND  ABBRE.  YET 

•/ 

JM 

022160 

1%  -  1 

/*  ASSUME  SUCCESS  FOR  NOW 

V 

JM 

022170 

INVLDS-"  ’ 

/*  CLEAR  INVALID  WORD  FLAG 

*/ 

JM 

022180 

JM 

022200 

IF  SENTPOSS  =  "K*  THEN  SENTPOSJ  =  "B"  /*  START  OF  SENT. 

*/ 

JM 

022230 

IF  CLSPGSS  -  "E*  THEN  CLSPOSS  =  "B"  /*  START  OF  NEW  CLAUSE 

*/ 

JM 

022240 

JM 

022250 

LEAD  PUNC: 

/*  CHECK  FOR  LEADING  PUNCTUATION 

V 

JM 

022260 

IF  LEN»=1  THEN  SGLCHAH 

/*  END  OF  WORD 

*/ 

JM 

022270 

AS-STR(WORDlS.l,l) 

AND  AS  <  "A")  OR 

JM 

022280 

IF  (AS  <  "0"  )  OR  (AS  >  "9" 

1 

JM 

022290 

(AS  >  "Z*  AND  AS  <  “a") 

1 

JM 

022300 

THEN  INVLCHR 

JM 

022  3  1  0 

JM 

022J20 

IF  AS  <*  "z"  THEN  CHKTRLG 

JM 

022330 

JM 

022340 

INVLCHR: 

/*  INVALID  LEADING  CHARACTER 

V 

JM 

022350 

IF  AS  -  *(*  THEN  NEG4  ( 3 1  - 

1  /*  NEGATIVE  SWITCH 

*/ 

JM 

022360 

WORD1S  ■=  STR(WORDlS,  2) 

JM 

022370 

LENS  =  LKN*  -  1 

JM 

022380 

GOTO  LEAD  PUNC 

JM 

022390 

JM 

022400 

CHKTRLG: 

/*  CHECK  FOR  TRAILING  PUNCTUATION 

*/ 

JM 

022410 

IF  LEN4  =  1  THEN  SGLCHAR 

/*  END  OF  WORD 

*/ 

JM 

022420 

A$  =STK (WOKD1S , LEN», 1) 

JM 

022430 

IF  (AS  <  "0"  )  OR  (AS  >  "9* 

AND  AS  <  "A")  OR 

I 

JM 

022440 

(AS  >  "Z"  AND  AS  <  “a") 

1 

JM 

022450 

THEN  INVTCHK 

JM 

072460 

JM 

022470 

IF  AS  <-  "z"  THEN  CHKNWSENT 

JM 

022480 

JM 

022490 

INVTCHR: 

/*  INVALID  TRAILING  CHARACTER 

V 

JM 

022500 

IF  AS  =  “I"  THEN  SETNEG 

JM 

022510 

j*  -  pose.  >:  ?"  -  as) 

JM 

022520 

IF  J%«0  THEN  BAR 

JM 

022530 

IF  A SO'-"  THEN  ENDSENT 

/*  CAN'T  BE  ABBRE. 

*/ 

JM 

0  2  2  r>  4  0 

WORDg$-STR(WORDlS, 1, LEN4-1) 

/*  GET  RID  OF  THE  PERIOD 

*/ 

JM 

022550 

TRAN (  WORDQS, 

1 

JM 

022560 

"  AuBDCcIXlBe  Ft  Gy  Hh  I 1 J  j  Kk  LlMmNnOoPpOyRr  SaTtUuVvWwXx  Y/Zz  *  ) 

1 

JM 

022570 

REPLACING 

JM 

022580 

IF  ABDRE4-0  THEN  ENDSENT 

JM 

022590 

FUR  QD»-1  TO  ABBRE4 

.TM 

M 
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022600  IP  STR(WORDQ$,  1,LEN»)  >  STR ( AB8RE$  (QD% )  ,  1 , LEN4 )  THEN  QD%*ABBR£»  JM 
022610  IF  STR(WORDQS,l,LEN»)  <>  STR ( ABBRE*  (Q0»)  ,  1 ,  LEN%)  THEN  DROP  JM 
022620  IF  LEN(ABBRE$(QD»)  )>LEN%+1  THEN  DROP  JM 
022630  FOUN4-1  JM 
022640  QD4-ABBREI  JM 
022650  DROP:  NEXT  QD»  JM 
0 22660  IF  FOUN4-0  THEN  ENDSENT  JM 
022670  BAR:  JM 
022680  IPA*«":"ORAS-*,*  THEN  SETCLS  JM 
022690  GOTO  RMV_CHR  JM 
022700  JM 
022710  SETNEG:  /*  SET  NEGATIVE  SWITCH  */  JM 
022720  NEG% ( 3 )  *  0  JM 
022730  GOTO  RMV_CHR  JM 
022740  JM 
022750  ENDSENT:  JM 
0  22760  SENTPOSS  -  "E"  /*  SET  END  OF  SENTENCE  FLAG  */  JM 
022770  IF  J»  ■  1  THEN  BBS  -  “Y*  JM 
022780  JM 
022790  SETCLS:  JM 
022800  IF  AS**,'  THEN  LIST%=LIST»+1  /*  COUNT  COMMAS  FOR  'LIST?'  »/  JM 
022810  CLSPOSS  1  -  "E*  /*  SET  END  OF  CLAUSE  FLAG  */  JM 
022820  JM 
0228  30  RMV  CHR:  /*  REMOVE  THE  LAST  CHAR.  OF  WORD  •/  JM 
022840  STR (WORD1S , L£N% , 1 J  =  *  *  JM 
022850  LEN%  *  LEN%  -  1  JM 
022860  GOTO  CHKTRLG  JM 
022870  JM 
022880  SGLCHAR;  /»  CHECK  FOR  VALID  SINGLE  CHARACTER,  'A’  OR  '  I*  OR  'a'  */  JM 
022890  IF  BBS  “  *Y"  THEN  SAV1  JM 
022900  AS  -  STR  (WORD IS  ,1,1)  JM 
022910  IF  AS  -  "I*  OR  AS  -  "A"  THEN  SAV2  /*  BEG.  OF  SENTENCE  */  JM 
022920  IF  AS  “  “a"  THEN  SP_RET  JM 
022930  GOTO  SAV3  JM 
022940  JM 
022950  SAV1 :  '  /*  SAVE  SENT.  AND  CLS.  FLAGS  */  JM 
022960  SENTPOSS  =  BS$  JM 
022970  CLSPOSS  -  BCS  JM 
022980  GOTO  SAV3  JM 
022990  JM 
023000  SAV2 :  /*  CHECK  AND  SAVE  SENT.  FLAG  */  JM 
023010  IP  SENTPOSS  -  "B"  THEN  SENTPOSS  -  *  *  JM 
023020  GOTO  SP_RET  JM 
023030  JM 
02  30  40  CHKNWSENT :  /»  CHECK  FOR  START  OF  NEW  SENTENCE  */  JM 
023050  AS  -  STR  (WORD1S ,  LEN% ,  1)  JM 
023060  /*  CHECK  FOR  ’  *S  *  OR  *  1  s  "  «/  JM 
023070  IF  AS- "3"  THEN  AS-*S*  JM 
023080  IF  AS*  "S "  AND  STR  (WORD  l  $ ,  LEN4-1 , 1)  -  *"  l  JM 
023090  THEN  LEN%  *  LEN»  -  2  JM 
023100  AS  -  STR (WORDlS ,1,1)  JM 
023120  IF  AS  <  ‘A*  THEN  SAV 3  JM 
023  1  30  IF  AS  >  "Z"  THEN  CHK_NUM  JM 
02  3140  GOTO  CHK_NUM  JM 
0  21150  JM 
023160  /*  CHECK  FOR  ACRONYMS,  PROPER  NOUNS  */  JM 
023170  IF  AS  > -  *a*  THEN  CHK  NUM  JM 
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023180  IP  BBS  «  "Y"  THEN  BADWD  JM 
023190  GOTO  SAV3  JM 
023200  JM 
023210  CHK_NUM:  /*  CHECK  POR  IMBEDDED  NUMBER  OR  NUMBERS  */  JM 
023220  J4  »  POS(  STR(WORDlS,l,LEN4)  <  “A*  )  JM 
023230  IF  J»  =  0  THEN  SP_RET  JM 
023240  IF  STR(WORDl$,J»,l)<>’.“  THEN  SAV3  JM 
023250  _  JM 
023260  BADWD:  '  /*  SET  BAD  WORD  PLAG  */  JM 
023270  INVLDS  “  "P"  JM 
023280  I»  »  0  JM 
023290  GOTO  SP_RET  JM 
023300  JM 
023310  SAV3 :  /*  SAVE  AND  SET  FLAGS  */  JM 
023320  INVLDS  -  "Y"  JM 
023330  IP  AS  <  'A’  AND  LEN4  <  3  AND  SENTPOSS  -  "E"  THEN  14  =  0  JM 
023340  JM 
023350  SPRET:  RETURN  /*  STRIP  PUNC.  SUB.  RETURN  */  JM 
023360  JM 
0233  70  /********•********'*“***********•*****************“************/  JM 
023380  /*  */  JM 
023390  /*  THIS  SUBROUTINE  PRINTS  ALL  WORDS  AND  FLAGS.  */  JM 
023400  /*  V  JM 
023410  /*****************•*******“********•*****»****»*************•“*/  JM 
023420  JM 
02  34  30  PRNT__WDS:  JM 
023440  JM 
023450  IP  PHCT4  -  1  THEN  NORML  JM 
023460  SAVPHS  (PHCT4)  -WORDSS  /*  SAVE  THE  LAST  WORD  */  JM 
023470  SAVPHL4  ( PHCT4 )  “LW%  ( 1 )  /*  SAVE  THE  LAST  WORD'S  LENGTH  */  JM 
023480  SAVSYL4 ( PHCT4) -TLC4  /*  SAVE  THE  SYLLABLE  COUNT  */  JM 
023490  IP  WSLS*’Y“  THEN  SAVREC1S ( PHCT4) “REC1S  JM 
023500  IF  WSL$-"Y"  THEN  WSLS-’N"  JM 
023510  WORDS$=SAVPH$ (1)  /•  USE  THE  FIRST  WORD  */  JM 
023520  LW»  ( 1 >  “SAVPHL4  ( 1 )  '  /*  USE  THE  1ST  WORD'S  LENGTH  »/  JM 
023530  TLC4-3AVSYL4 (1)  /*  USE  THE  1ST  WORD'S  SYL.  CT.  */  JM 
023540  IF  SAVSUBL*  (1)<>  0  THEN  STR  (WORDSS  ,  25, 35)  =STR  (SAVREC  1$(1)  ,21,35)  JM 
02  3550  FOR  Q*  «  1  TO  PHCT4-1  /*  MOVE  WORDS  IN  THE  ARRAY  */  JM 
023560  SAVPHS  (Q4)  “SAVPHS  (Q4H)  JM 
023570  SAVPHL4 (Q4) “SAVPHL4 (U4+1)  JM 
023580  SAVSYL4 (p») “SAVSYLM 4  tl )  JM 
023590  -SAVSUBS  (Q4)  “SAVSUBS (Q4+1)  JM 
023600  SAVSUBL4 (Q4) “SAVSUBL4 ((J4  +  1)  JM 
023610  SAVREC1S ( Q% ) “SAVREC1S ( Q4  +  1)  JM 
023620  NEXT  04  JM 
023630  SAVSUBL4 ( PHCT4 ) “0  JM 
023640  K44»Prti‘T»  :GOTO  tJXH‘1  JM 
02  3650  NORM).:  K44-IW4  JM 
023660  IF  CWS“*X*  THEN  K44-1  : IF  CWS-’Y”  THEN  LNPAR  JM 
023670  IF  K  4  4  =  0  THEN  LNPAR  /•  K44  =■  #  OF  WORDS  •/  JM 
02  36H0  UXJPl  :  FUR  14=1  TO  K44  JM 
023690  IF  14  -  1  THEN  SKIPT  JM 
0  23  700  PHOT*  =■  PHCT4-1  JM 
02  37  1  0  Wi'KDSS’SAVPHS(l)  JM 
023720  ..W  4  (  1 4 1  “SAVPHL4  (  1 )  JM 
023730  TIa'4  =SAVSYI.4  ( 1 )  JM 
02  3  740  IF  SAVSI7BL4  (  1  )  <>0  THEN  STR  (WORDSS  r  2  5 ,  36)  -  I  JM 
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023750 

023760 

023770 

023780 

023790 

023800 

023810 

023820 

023830 

023840 

023850 

023860 

023870 

023880 

023890 

023900 

023910 

023920 

023930 

023940 

023950 

023960 

023970 

023980 

023990 

024000 

024010 

024020 

024030 

024035 

024040 

024050 

024060 

024070 

024080 

024090 

024100 

024110 

024120 

024130 

024140 

024150 

024160 

024170 

024180 

024190 

024200 

024210 

024220 

024230 

024240 

024250 

024260 

024270 

024280 

024290 

024300 


SKIPT: 


STR(SAVREC1*(1)  ,21,35) 

IF  PHCT»=1  THEN  SKIPT 

FOR  Q%  =  1  TO  PHCT4-1  /*  MOVE  WORDS  IN  THE  ARRAY  */ 
SAVSYL*  (Q%)  -SAVSYL*  (01+1) 

S  A  VP  Hi  <Q»)  -SAVPH*  (Q%+1) 

SAVPHL% (Q%) -SAVPHL9 (Q%+1) 

SAVSUBS (0%) -SAVSUB* (Q%+1) 

SAVSUBL*  (Q%)  -SAVSUBL*  (Q%+1) 

SAVREC1* (Q») -SAVRECl* (Q*+l) 

NEXT  Q% 

SAVSUBL% ( PHCT% ) "0 

IF  D%*2  THEN  SUBT  /»  FLAGS  ONLY  */ 


/•  COMPUTE  THE  LENGTH  OF  DATA  TO  PRINT  (IF  IT'S  TOO  LONG  FOR  •/ 
/*  THIS  LINE,  PRINT  THE  LINE  AND  PUT  DATA  ON  NEXT  LINE)  */ 

J%  -  LW%(I%) 

Kl%  =  0 
K2%  =*  0 
K}%  -  1 

/*  CHECK  TOR  UNCOMMON  WORD  */ 

IF  UCWFLG$(I%)  =  "Y"  AND  UNCOM$»*Y*  ! 

THEN  PRTUNC  /*  UNC  WORD  AND  OPTION  SELECTED  */ 

/*  IT'S  A  REGULAR  WORD  -  CHECK  FOR  SUBSTITUTES  */ 

IF  NUM_SUB$  «"0"  OR  STR (WORDS*, 25, 1)  ••  *  OR  INVLDS-’Y"  ! 
THEN  CHKLL  /*  NO  SUBS.*/ 

K 1%  =■  -1 

Kl%  -  POS (STR (WORDSi ,25,20)  ■*")/*  77????  WORDS  7777*/ 
J%  »  J%  +  Kl%  +  6  /*  ADD  SPACES  FOR  */ 

/*  CHECK  ON  SECOND  SUBSTITUTE  */ 

IF  NUM_SUB$™  "1"  OR  STR  (WORDS* ,  45, 1) *  THEN  CHKLL 
/*  ONLY  ONE  SUBSTITUTE  NEEDED  OR  NO  2ND  SUBS.  */ 


K2% 

K2» 

J% 


-1 

POS  (STR (WORDS*  ,45,15)""  ") 


J%  +  K2»  +1 
/*  CHECK  ON  LINE  LENGTH  */ 


/*  ADD  SPACE  FOR  '/*  */ 


CHKLL: 


IF  IO%  +  J»  >  LL%  THEN  GOSUB  PRTLNE  /*  PRINT  LINE  */ 

IF  K3%  =*  0  THEN  OUT  /*  ERROR  FROM  PRTLNE  */ 


/»  BUILD  OUTPUT  LINE  */ 

IF  Kl%  -  0  THEN  PIT 
STR(OLINE*, IO%, 1)  -  *<■ 
IO%  =  IO%  +  1 


/*  NO  SUBSTITUTES  FOR  WORD  */ 


PIT: 


/*  NOW  ADD  THE  SUBSTITUTES  */ 

STR  (OLINE*,  IO%,LW%  (1%)  )  =■  STR(WORDS*,  1 ,  LW%  (I»)  ) 


Z98 
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024310 

024320 

024330 

024360 

024370 

024380 

024390 

024400 

024410 

024420 

024430 

024440 

024450 

024460 

024470 

024480 

024490 

024500 

024510 

024520 

024530 

024540 

024550 

024560  PUSH: 

024570 

024S30 

024590 

024600 

024610 

024620  PRTUNC : 

024630 

024640 

024650 

024660 

024670 

024680 

024690 

024700 

024710 

024720 

024730 

024740 

024750 

024760 

024770 

024800 

024810 

024820 

0248  30 

024840  SUBT: 

024850 

024860 

024870 

024900 

024910 

024920 

024930 


WC1%=WC1%+1  /*  INCREMENT  THE  WORD  COUNT  */  JM 

WP1%-WP1%+1  /*  INCREMENT  THE  WORDS  PER  PAR.  COUNT  */  JM 

SLC1%=SLC1%+TLC%  /*  INCREMENT  THE  SYLLABLE  COUNT  •/  JM 

IO%  «  IO»  +  LW%(I%)  JM 

IF  Kl%  -  0  THEN  SUBT  /*  STILL  NO  SUBSTITUTES  */ 

/*  INSERT  FIRST  SUBSTITUTE  */ 

STR(OLINE!,  IO%,  3)  -"><*“ 

IO%  -  IO»  +  3 

STR  (OLI  NE$  , IO% , Kl% )  =  STR (WORDS! ,  25 ,  Kl% ) 

IO%  -  IO%  +  Kl% 

/*  CHECK  FOR  SECOND  SUBSTITUTE  */ 

IF  K2%  »  0  THEN  FNSH 
STR ( OL I NE$ , IO% ,  1 )  «  "/" 

IO%  -  IO%  *  1 

STR (OLINE!  ,  IO%  ,  K2% )  ■  STR  (WORDS!,  45 ,  K2%) 

IO^  -  IO%  +  K2% 

/*  FINISH  THE  ENTRY  */ 

STR(OLINE$, IO%, 2) 

IO%  -  IO%  ¥  2 

GOTO  SORT 


/»  PRINT  UNCOMMON  WORDS  */ 


J%  -  J%  ♦  2 


/*  CHECK  LINE  LENGTH  */ 


/•ADD  (...)  •/ 


PFLAG%  =  K3% 

IF  IO%  +  J%  >  LL%  THEN  GOSUB  PRTLNE 

IF  PFIAG%  -0  THEN  OUT  /•  ERROR  RETURN  •/ 

STR(OLINE$, IO%, 1) =" 1 " 

IO%  -  IO%  +  1 

L$=STR( WORDS!, LW%(I%)  ,1) 

PZ%*POS(*)  *-L$) 

IF  PZ%>0  THEN  LW%(I%(-LW%(I%)-1 
STR(OLINE!,IO%,LW%(I%)  )  »  STR  (WORDS!,  1,  LW%  (1%)  ) 

WC1%=*WC1%  +  1  /•  INCREMENT  THE  WORD  COUNT 

WP1%-WP1%  +  1  /•  INCREMENT  THE  WORDS  PER  PAR.  COUNT 

SLC1%»SLCI%+TLC%  /*  INCREMENT  THE  SYLLABLE  COUNT 

IO%  -  IO%  +  LW%(I%) 

STR(OLINEl,IO%,lj»")-  :IO%>IO%+l  : UCWPLG! ( 1%) " 

IF  PZ%>0  THEN  STR  (OLINE!,  IO%, 1)  *STR  (WORDS!,  LW%  (1%)  +1,1) 

IF  PZ%>0  THEN  IO%-IO%+l 

IF  EOS%»0  THEN  LSENT  /‘HAVEN'T  FOUND  END  OF  SENTENCE 
WC%-WC%+WC1%  /•  INCREMENT  WORD  COUNT 

WP%-WP%+WP1%  /•  INCREMENT  WORDS/PAR  COUNT 

SLC%  =  SLC%+SLC1%  /*  INCREMENT  SYLLABLE  COUNT 

EOS%,  WC1%,  WP1%,  SLC1%  =0  /*  RESET  BUFFER  VARIABLES 

IF  UNCPT%>1  THEN  GOSUB  ADD  UNCWL  /*  ADD  UNCOMMON  WORDS 


/•  PRINT  THE  FLAILS  -  CHECK  LONG  SENTENCE  FLAG  */ 
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024940 

024950 

024960 

024970 

024980 

024990 

025000 

025010 

025020 

025030 

025040 

025050 

025060 

025070 

025080 

025090 

025100 

025110 

025120 

025130 

025140 

025150 

025160 

025170 

025180 

025190 

025200 

025210 

025220 

025230 

025240 

025250 

025260 

025270 

025370 

025480 

025490 

025500 

025510 

025520 

025530 

025540 

025550 

025560 

025570 

025580 

025590 

025600 

025610 

025620 

025630 

025640 

025650 

025660 

025670 

025680 

025690 


LSENT:  IF  LSENT%(I%)-0  OK  LNG  S£N*<>*Y"  THEN  PASSP  /*NO  LONG  SEN.*/  JM 


P FLAG 4  *  K3« 

IF  IO%  +  7  >  LL%  THEN  GOSUB  PRTLNE 
IF  PFLAG%  -  0  THEN  OUT  /*  ERROR 

CONVERT  LSENT%(I%)  TO  Kl$,  PIC  (III) 
STR(OLINE$,IO%,7)«*<**6  K1S  6  ’*>  * 

IO»  -  IO%  +  7  : LSENT4 ( 1%) *0 

IF  (LIST%<3  AND  CONSIS%-0)  OR  LIST%<5  THEN  PASSP 
PFLAG»-K3» 

IF  IO»  +  11  >  LL%  THEN  GOSUB  PRTLNE 
IF  PFLAG%  -  0  THEN  OUT  /*  ERROR  RETURN 

STR(OLINE$,IO%,ll)-*/*  LIST?  *>* 

IO%  -  IO%  +  11 


*  ERROR  RETURN  */ 


PASSP : 


/»  CHECK  ON  PASSIVE  FLAG  */  JM 

JM 

IF  PASSVSO’Y*  AND  TRNK_PVS< >" Y"  THEN  DNEG  JM 

IF  PASSVF$(I%)<>  "Y*  THEN  DNEG  JM 

PF^AG%  =  K3%  JM 

IF  IO%  ♦  19  >  LL%  THEN  GOSUB  PRTLNE  JM 

IF  PPLAG%  -  0  THEN  OUT  /*  ERROR  RETURN  */  JM 

STR(OLINE$,IO%,19)  -  “<*  PASSIVE  VOICE  *>*  JM 

IO%  -  IO%  +  19  :PASSVF$(IW%)»*  *  JM 

JM 

LAG  */  JM 

JM 

/*  NO  DOUBLE  NEGATIVE  OPTION  •/  JM 


/*  CHECK  DOUBLE  NEGATIVE  FLAG  */  JM 

JM 

DNEG:  IF  N£G$0*Y*  THEN  PREP  /*  NO  DOUBLE  NEGATIVE  OPTION  •/  JM 

IF  DNFL*  ( !%)<'>“Y“  THEN  PREP  JM 

PFLAG%  =■  K3%  JM 

IF  IO%  +  21  >  LL%  THEN  GOSUB  PRTLNE  JM 

IF  PFLAG%  -  0  THEN  OUT  /*  ERROR  RETURN  */  JM 

STR(OLINE$f  IO%/  21)  -  *<*  DOUBLE  NEGATIVE  •>"  JM 

IO%  -  IO%  +  21  : DNFL$ ( IW%)  ="  *  JM 

'  JM 

/*  CHECK  PREPOSITION  FLAG  */  JM 

JM 

PREP:  IF  PREP_CNTS<?"Y"  THEN  FUTURE  JM 

IF  PREPFL% (1%) =  0  THEN  FUTURE  JM 

PFLAG%  -  K3%  JM 

IF  IO%  +  33  >  LL%  THEN  GOSUB  PRTU(E  JM 

IF  PPLAG%  -  0  THEN  OUT  /*  ERROR  RETURN  */  JM 

CONVERT  PREPFL%(I%)  TO  OOS,  PIC  (III)  JM 

?TR(OLINE*,IO%,  33)  -  *<*  TOO  MANY  (*  k  OO $  k  ")  PREPOSI1  JM 

TIONS  *)"  JM 

PREPFL%  ( 1%) -0  /•  RESET  PREP.  FLAG  */  JM 

IO%  »  IO%  +33  JM 

JM 

/*  LEAVE  ROOM  FOR  FUTURE  EXPANSION  •/  JM 

JM 

FUTURE:  IO%  -  IO%  +  1  JM 

NEXT  1%  /*  THIS  INCREMENTS  THE  BIG  LOOP  OF  THIS  ROUTINE  »/  JM 

JM 

/*  NOW  CHECK  UNIQUE  FLAGS  -  CHECK  LONG  PARAGRAPH  FLAG  */  JM 


IF  END  O  PARS  O’Y"  THEN  PERMSG 
END  O  PARS  -  *  "  / 


/*  RESET  END  O  PAR  FLAG  */  JM 
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025700  IF  LNG_P AR$ <  >  "  Y  “  THEN  SPRST  /*  PRINT  OUT  THE  PARAGRAPH  */  JM 
025710  IF  SP%<LNGSNT%  AND  WP%<LNGWDS%  JM 
025720  THEN  SPRST  /*  NOT  TOO  LONG  */  JM 
025730  PFLAG%  *  K3%  JM 
025740  IF  IO»  +  57  >  LL»  THEN  GOSUS  PRTLNE  JM 
025750  IF  PFLAG%  -  0  THEN  OUT  JM 
025760  CONVERT  SP%  TO  00$,  PIC  («H>  JM 
025770  CONVERT  WP%  TO  01$,  PIC  (HH)  JM 
025780  STR(OLINE$,  10%,  57) -*<*  PARAGRAPH  TOO  LONG  (*  it  00$  ii  !  JM 
025790  “  SENTENCES  WITH  *6  01$  6  *  WORDS  )  *>’  JM 
025800  IO%  »  IO%  +■  57  :SP%,WP%=0  JM 
025810  GOTO  PERMSG  JM 
025820  SPRST:  WP%,SP%  -  0  JM 
025830  PFLAG%  =  K3%  JM 
025840  IF  IO%  >  1  THEN  GOSUB  PRTLNE  JM 
025850  IF  PFLAG%  -  0  THEN  OUT  JM 
025860  JM 
025870  /*  CHECK  FOR  PEKSONAL  SENTENCE  MESSAGE;  */  JM 
025880  /*  NO  NEED  FOR  THIS  CODE  IN  PRT  WDS  BECAUSE  THE  LAST  WORD  */  JM 
025890  /,*  CAN  ONLY  HAPPEN  HERE.  */  JM 
025900  JM 
025910  PERMSG:  IF  E_0_F$O"Y"  OR  PERS_SENT$  <>*Y"  THEN  RESET  JM 
025920  K1  -'0  JM 
025930  IF  INT  ANL$<> "Y"  THEN  SC-SC%  JM 

025940  IF  I  NT _ AN L$  = "  Y **  THEN  SC-SC%+XSC%  JM 

025950  IF  SC-0  THEN  Kl-0  JM 
025960  IF  SC-0  THEN  NOS NT  JM 
025970  PE=PE%  JM 
025980  K1-PE*100.0/SC  JM 
025990  NOSNT:  K  J%  »  1  JM 
026000  PFLAG%  -  K3%  JM 
026010  IF  IO%  +  30  >  LL%  THEN  GOSUB  PRTLNE  JM 
026020  IF  PFlAi;%  =>  0  THEN  OUT  JM 
026030  STK(OLINE$,  IO%,  2)  -  "<**  JM 
026040  IO%-IO%f3  •  '  JM 
026050  IF  Kl<100  THEN  CONVERT  Kl  TO  STR  (OLINE$ ,  IO%  ,  4)  ,  PIC(H.t)!  JM 
026060  ELSE  CONVERT  Kl  TO  STR(OLINE$, IO%, 5) ,  PIC(##|.#I  JM 
026070  IP  Kl<100  THEN  IO%-IO%+4  ELSE  IO%-IO»+5  JM 
026080  STR(0LINE$, IO%, 23J -’%  PERSONAL  SENTENCES  *>*  JM 
026090  IO%-IO%+23  JM 
026100  GOSUB  PRTLNE  JM 
026110  IF  K3%  -  0  THEN  OUT  JM 
026120  JM 
026130  /*  RESET  WORK  AREAS  */  JM 
026140  JM 
026150  RESET:  IF  CW$  =  "X"  THEN  REMOVE  JM 
026160  WORDS$()  -  ALL(HEX(20)}  JM 
026170  IW%  -  0  JM 
026180  GOTO  POSTPONE  JM 
026190  JM 
026200  /*  REMOVE  FIRST  WORD  •/  JM 
026210  JM 
026220  REMOVE:  IP  IW%  < -  1  THEN  SINGLE  JM 
026230  FOR  1%  -  1  TO  (IW%-1)  JM 
026240  WOHDS$(I%)  =  WORDS$  (I%  +  1)  JM 
026250  PASSVFS ( I%J  =  PASSVP$ ( I  %  +  1 )  JM 
026260  DNFL$ ( 1%)  =  DNFL$(I%+1)  JM 
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026270 

026280 

026290 

026300 

026310 

026320 

026330 

026340 

0263S0 

026360 

026370 

026380 

026390 

026400 

026410 

026420 

026430 

026440 

0264S0 

026460 

026470 

026480 

026490 

026500 

026510 

026520 

026530 

026540 

026550 

026560 

026570 

026580 

026590 

026600 

026601 

026610 

026620 

026630 

026640 

026650 

026660 

026670 

026680 

026690 

026700 

026710 

026720 

026730 

026740 

026750 

026760 

026770 

026780 

026790 

026800 

026810 

026820 


NOUNPL*  ( 1%)  -  NOUNPL*  ( I%  +  1) 

UCWPLG*  ( 1%)  -  UCWPLG*(I4+1) 

LCLSPL4  (It)  -  LCLSFH  (14+1) 

LSENT4 ( 1%)  »  LSENT4(I4+1) 

PREPPL4 ( 1% )  -  PREPPLI (14+1) 

LW4(I4)  -  LW4(I4+1) 

NEXT  14 

WORDS* (IW4)  -  ALL (HEX ( 20 )  ) 

PASS VF$  ( IW4 )  -  *  * 

DNPL* ( IW4)  -  *  ' 

NOUNFL* ( I W4 )  -  *  * 

UCWPLGS  ( IW4 )'  -  "  * 

LCLSFL4  ( IW4 )  »  0 
LSENT4 ( IW4 )  ■  0 
PREPPLt  ( IWt)  -  0 
LW% ( IW4J  -  0 
GOTO  POSTPONE 

SINGLE:  WORDS*  (1)  -  ALL(HEX(20)) 

PASSVP* (1)  -  "  * 

DNFL*(1)  -  *  ■ 

NOUNPL* (1)  -  *  " 

UCWFLG* (1)  -  ’  “ 

LCLSFL4  ( 1)  -  0 

LSENT9  ( 1)  -  0 
PREPFL4 (1)  -  0 
LW4 ( 1 )  -  0 
POSTPONE: 

IF  IW«  >  0  THEN  IWt  »  IW4-1 
IF  D»  »  3  THEN  OUT 

/*  CHECK  ON  UNCOMMON  WORDS  AND  PRINT  IF  TABLE  IS  FULL  •/ 

IF  IDX4  <  200  THEN  OUT 
GOSUB  UWL 

GOSUB  TOP  ' 

OUT:  IF  CW*-*Y"  THEN  CW*«”  * 

IF  WC14-0  THEN  LIST4,  CONSIS4*0 

RETURN  /*  PRNT  WDS  SUB.  RETURN 


THIS  SUBROUTINE  PRINTS  ALL  WORDS  AND  FLAGS  FROM  CHKPHSFL. 
THIS  SUB.  IS  SIMILAR  TO  PKNT_WDS,  BUT  ONLY  CALLED  WHEN 
WORDS  ARE  REMOVED  FROM  POSSIBLE  PHRASES. 


PRT  WDS: 


IF  PHCT4  <>  1  THEN  SKIPTI 
WORDZJ-WORDO* 

LEN04-LW4 (1) 

TL04-TLC4 
GOTO  SKIPTO 
PHCT4  »  PHCT4-1 
WORDZ*-SAVPH*(l) 

LENOt  =S AVPHLt ( 1 ) 
TLOt-SAVSYL»(l) 
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026830 

026840 

026860 

026860 

026870 

026880 

026890 

026900 

026910 

026920 

026930 

026940 

0269S0 

026960 

026970 

026980 

026990 

027000 

027010 

027020 

027030 

027040 

027050 

027060 

02/070 

027080 

027090 

027100 

027110 

027120 

027130 

027140 

027150 

027160 

027170 

027180 

027190 

027200 

027210 

027220 

027230 

027240 

027250 

027260 

027270 

027280 

027290 

027300 

027310 

027320 

027330 

027340 

027350 

027360 

027370 

027380 

027390 


SKIPTO: 


IF  SAVSUBL»(l)O0  THEN  STR(WORDZ$,25,  35)  =  '• 
STR(SAVR£C1$(1)  .21,35) 

IF  PHCT4-1  THEN  SKIPTO 

FOR  Q%  -  1  TO  PHCT4-1  /*  MOVE  WORDS  IN  THE  ARRAY  */ 

SAVSYL4 (Q4) -SAVSYL4 (Q4  +  1) 

SAVPH* (Q4) -SAVPH*  (Q4+1) 

SAVPHL4  <Q4)  -SAVPHU  (Q4+1) 

SAVSUBS (Q4) -SAVSUBS (Q4+1) 

SAVSUBL4(Q4) «SAVSUBL4 (Q4+1) 
SAVRECl*(Q4)»SAVRECl$(Q4+l) 

NEXT  Q4 

SAVSUBL4 (PHCT%) «0 

IF  D4*2  THEN  LSENTO  /*  FLAGS  ONLY  */ 


/*  COMPUTE  THE  LENGTH  OF  DATA  TO  PRINT  (IF  IT’S  TOO  LONG  FOR  */ 
/*  THIS  LINE,  PRINT  THE  LINE  AND  PUT  DATA  ON  NEXT  LINE)  V 

J4  -  LEN04 
Kl»  -  0 
K?4  -  0 
K34  -  1 

/•  CHECK  FOR  UNCOMMON  WORD  */ 

IF  UCWFLG$(I4)  -  "Y"  AND  UNCOMJ-’Y"  1 

THEN  PRTUNCO  /*  UNC  WORD  AND  OPTION  SELECTED  */ 

/*  IT'S  A  REGULAR  WORD  -  CHECK  FOR  SUBSTITUTES  */ 

IF  NUMSUB*  --0’  OR  STR (WORDZJ ,25,1)""  *  THEN  CHKLLO/*  NO  SUBS.*/ 
K14  3  -1 

Kit  -  POS (STR(WORDZ$, 25, 20)  -*")/*  777777  WORDS  7777*/ 
J4  -  J4  *■  K14  +6  /*  ADD  SPACES  FOR  */ 

/*  CHECK  ON  SECOND  SUBSTITUTE  */ 

IF  NUM_SUB$-*1"  OR  STK(W0RDZ$,45,1)3’  *  THEN  CHKLLO 
/*  ONLY  ONE  SUBSTITUTE  NEEDED  OR  NO  2ND  SUBS.  */ 


K24  -  -1 

K24  -  POS(STR(WORDZ$,45,15)-*  *) 
J4  3  J4  ♦  K24  +1 

/*  CHECK  ON  LINE  LENGTH  */ 


/*  ADD  SPACE  FOR  ’/' 


CHKLIX):  IF  [04  +  J4  >  LL4  THEN  GOSUB  PRTLNE  /*  PRINT  LINE  */ 

IF  K  3%  3  0  THEN  OUTO  /*  ERROR  FROM  PRTLNE  */ 


/*  BUILD  OUTPUT  LINE  */ 
IF  K 14  3  0  THEN  PITO 


/*  NO  SUBSTITUTES  FOR  WORD  */ 


STR(OLINES, 104, 1) 
104  -  104  ♦  1 


'<* 


/*  NOW  ADD  THE  SUBSTITUTES  */ 

PITO:  STR(OLINE$,  104,  LEN04 )  *  STR(WORDZ$,  1,  LEN04) 

WC14-WC14E1  /*  INCREMENT  THE  WORD  COUNT  */ 


JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 
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027400  WP1%«WP1%+1  /*  INCREMENT  THE  WORDS  PER  PAR.  COUNT  */  JM 
027410  SLCl%=SLCl%+TLO%  /*  INCREMENT  THE  SYLLABLE  COUNT  */  JM 
027420  IO%  *  IO%  +  LENO%  JM 
027430  IF  Kl»  =  0  THEN  LSENTO  /*  STILL  NO  SUBSTITUTES  */  JM 
027440  JM 
027450  /*  INSERT  FIRST  SUBSTITUTE  */  JM 
027460  JM 
027470  STR(OLINE$,IO%,  3)  “*><**  JM 
027480  IO»  -  IO%  ♦  3  JM 
027490  STR  (OL I NE$ ,  IO% ,  Kl%)  -  STR(WOR0Z$ , 25, Kl%)  JM 
027500  IO%  -  IO%  +  Kl%  JM 
027510  JM 
027520  /*  CHECK  FOR  SECOND  SUBSTITUTE  */  JM 
027530  JM 
027540  IF  K2%»0  THEN  FNSHO  JM 
027550  STR(0LINE$, IO%, 1)  -  */*  JM 
027560  IO%  -  IO%  ♦  1  JM 
027570  STRIOLINES, IO»,K2%)  =  STR(WORDZ$ , 45, K2%)  JM 
027580  IO%  »  IO%  *  K2%  JM 
027590  f  JM 
027600  /*  FINISH  THE  ENTRY  */  JM 
027610  JM 
027620  FNSHO:  STR (OLINES, IO% , 2) JM 
027630  IO%  *  10%  *  2  JM 
027640  GOTO  LSENTO  JM 
027650  JM 
027660  /*  PRINT  UNCOMMON  WORDS  */  JM 
027670  JM 
027680  PRTUNCO: J%  -  J%  ♦  2  /*  ADD  (...)  */  JM 
027690  JM 
027700  /*  CHECK  LINE  LENGTH  */  JM 
027710  JM 
027720  PFLAG%  =*  K3%  JM 
0277  30  IF  IO%  ♦  J%  >  LL%  THEN  GOSUB  PRTLNE  JM 
027740  IF  PFLAG%  -0  THEN  OUTO  '  /*  ERROR  RETURN  */  JM 
027750  STR(OLINE$,IO%,l)-*(*  JM 
027760  IO%  -  10%  ♦  1  JM 
027770  t.$-STR(WORDZ$,LENO%,  1)  JM 
027780  PZ%«POS ,!"*L$)  JM 
027790  IF  PZ%>0  THEN  LENO%>LENO%-l  JM 
027800  STR  (OLINES,  IO%  ,  LENO% )  “  STR  (WORDZJ ,  1 ,  LENO% )  JM 
027810  WC1%-WC1%  +  1  /»  INCREMENT  THE  WORD  COUNT  */  JM 
027820  WP1%*WP1%  +  1  /*  INCREMENT  THE  WORDS  PER  PAR.  COUNT  */  JM 
027830  3LCl%»SLCl%  +  TLO%  /*  INCREMENT  THE  SYLLABLE  COUNT  */  JM 
027840  IO%  -  IO%  ♦  LENO%  JM 
027850  STR(OLINE$, IO%, 1) -*| •  :IO%>IO%+l  : UCWFLG$ (!%;»"  *  JM 
027860  IF  PZ%>0  THEN  STR  (OLINEi ,  10%  ,  1)  -STR(W0RDZ$,  LENO%  +  l ,  1)  JM 
027870  IF  PZ%)0  THEN  IO%-IO%+l  JM 
027880  JM 
027890  /*  PRINT  THE  FLAGS  -  CHECK  LONG  SENTENCE  FLAG  */  JM 
027900  JM 
027910  LSENTO:  IF  LSENT%(I%)«0  THEN  PASSFO  /*  NO  LONG  SENT.  */  JM 
027920  IF  LNG_SEN$<>*Y"  THEN  PASSFO  /*  LONG  SEN.  OPTION  NOT  Y  */  JM 
027930  PPLAG%  =  K3%  JM 
027940  IF  IO%  +  7  >  LL%  THEN  GOSUB  PRTLNE  JM 
027950  IF  PFLAG%  =  0  THEN  OUTO  /*  ERROR  RETURN  */  JM 
027960  CONVERT  LSENT%(I%|  TO  Kl$,  PIC  (lit)  JM 
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027970  STR(OLINE$, IO%, 7) -"<**&  Kl$  i  **>*  JM 
027980  10%  -  IO%  +  7  : LSENT% ( 1%) -0  JM 
027990  IF  (LIST%<3  AND  CON3IS%-0)  OR  LIST%<5  THEN  PASSFO  JM 
028000  PFLAG%-K3%  JM 
028010  IF  IO%  +  11  >  LL%  THEN  GOSUB  PRTLNE  JM 
028020  IF  PFLAG%  =  0  THEN  OUT  /*  ERROR  RETURN  */  JM 
028030  STR(0LINE$,I0%,11)«"<*  LIST?  •>"  JM 
028040  IO»  -  IO»  +11  JM 
028050  JM 
028060  /*  CHECK  ON  PASSIVE  FLAG  */  JM 
028070  JM 
028080  PASSFO:  IF  PASSV$<>’Y’  AND  TRNK_PV$<>"Y*  THEN  DNEGO  JM 
028090  IF  PASSVFS  (1%)  <>  *Y“  THEN  DNEGO  JM 
028100  PFLAG4  -  K3»  JM 
028110  IF  IO%  +  19  >  LL%  THEN  GOSUB  PRTLNE  JM 
028120  IF  PFLAG%  -  0  THEN  OUTO  /*  ERROR  RETURN  •/  JM 
028130  STR(OLINES,  IO% ,  19)  -  *<*  PASSIVE  VOICE  *>  "  JM 
028140  IO%  -  IO%  +  19  :PASSVF$(IW%)-*  *  JM 
028150  JM 
028160  /*,  CHECK  DOUBLE  NEGATIVE  FLAG  */  JM 
028170  JM 
028180  DNEGO:  IF  NEGSO’Y*  THEN  PREPO  JM 
028190  IF  DNFL4  ( I%)0“Y"  THEN  PREPO  JM 
028200  PFLAG%  =  K3%  JM 
028210  IF  IO%  v  21  >  LL%  THEN  GOSUB  PRTLNE  JM 
028220  IF  PFLAG%  =  0  THEN  OUTO  /•  ERROR  RETURN  */  JM 
028230  STR(OLINE$, IO%, 21)  -  *<*  DOUBLE  NEGATIVE  »>"  JM 
028240  IO%  -  IO%  +  21  : DNFLS ( IW%) •*  •  JM 
028440  JM 
028450  /*  CHECK  PREPOSITION  FLAG  •/  JM 
028460  JM 
028470  PREPO:  IF  PREP_CNTSO"Y"  THEN  FUTURBO  JM 
028480  IF  PREPFL%  (  1%)  =■  0  THEN  FUTUREO  JM 
028490  PFLAG%  =  K3%  JM 
028500  IF  IO%  f  33  >  LL%  THEN  GOSUB  PRTLNE  JM 
028510  IF  PFLAG4  =  0  THEN  OUTO  /»  ERROR  RETURN  */  JM 
028520  CONVERT  PKEPFL%(I%)  TO  OOJ,  PIC  (Ml)  JM 
028530  STR(OLINE$,  10%,  33)  *  '<*  TOO  MANY  (’  6  OOJ  4  ')  PREPOSI!  JM 
028540  TIONS  *>"  JM 
028550  PR£PFL%  ( I %)  =0  /*  RESET  PREP.  FLAG  */  JM 
028560  IO%  =  IO%  +  33  JM 
028570  JM 
028580  /*  LEAVE  ROOM  FOR  FUTURE  EXPANSION  */  JM 
028590  JM 
028600  FUTUREO: IO%  =  IO%  +  1  JM 
028610  JM 
028620  /*  NOW  CHECK  UNIQUE  FLAGS  -  CHECK  LONG  PARAGRAPH  FLAG  */  JM 
028630  JM 
028640  IF  END__0_PAR$  <>  "Y"  THEN  RESETO  /*  NO  END  O  PAR  */  JM 
028650  END_0_PAR$  ■  *  "  /*  RESET  END_0_PAR  FLAG  •/  JM 
028660  IF  LNG_PAR$ <>" Y"  THEN  SPRSTO  /•  PRINT  THE  PARAGRAPH  */  JM 
028670  IF  SP%  <  LNGSNT%  AND  WP%  <  LNGWDS%  JM 
028680  THEN  SPRSTO  /*  NOT  TOO  LONG  */  JM 
028690  PFLAG%  =  K3%  JM 
028700  IF  IO%  f  57  >  LL%  THEN  GOSUB  PRTLNE  JM 
028710  IF  PFLAG%  =  0  THEN  OUTO  JM 
028720  CONVERT  SP%  TO  00$ ,  PIC  (|f|)  JM 
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028730 

028740 

028750 

028760 

028770 

028780 

028790 

028800 

028810 

028820 

028830 

028840 

028850 

028860 

028870 

028880 

028890 

028900 

028910 

028920 

028930 

028940 

028950 

028960 

028970 

028980 

028990 

029000 

029010 

029020 

029030 

029040 

029050 

029060 

029070 

029080 

029090 

029100 

029110 

029120 

029130 

029140 

029150 

029160 

029170 

029180 

029190 

029200 

029210 

029220 

029221 

029230 

029240 

029250 

029260 

029270 

029280 


CONVERT  WP»  TO  01$,  PIC  (||M) 

STR(OLINE$,IO»,57)«*<*  PARAGRAPH  TOO  LONG  (*  i  OOS  6  ! 

*  SENTENCES  WITH  "6  01$  6  *  WORDS  I  *>* 

IO»  -  IO«  57  >SP%,WP»«0 

GOTO  RESETO 

SPRSTO:  SP»  -  0  /*  CODE  TO  PUT  END_0_PARS  ON  SEPERATE  LINES  */ 

WP»  -  0  /*  WORDS  PER  PARAGRAPH  -  0  */ 

PPLAG*  »  K3« 

IP  IO»  >  1  THEN  GOSUB  PRTLNE 
IP  PPLAG*  -  0  THEN  OUTO 

/•  RESET  WORK  AREAS  */ 

RESETO:  IP  IW»  <  -  1  THEN  SING LEO 
FOR  I*  -  1  TO  <IW»-1) 

PASSVPS  ( I»)  -  PASSVPS  ( 1%-H) 

DNFL$(I»)  - 
NOUNPLS ( I %  > 

UCWPLGS  (It) 
f  LCLSFL*(I%) 

LSENT*  ( 1%)  ' 


JM 


DNFL$(I»  +  1) 

»  NOUNPLS  ( 1%  +1) 

-  UCWFLG$  ( I%  +  1) 

-  LCLSFL4  (I%+1) 
•  LSENT% ( 1%+lJ 

PREPFL4  ( I  % )  =  PREPFL4  ( 14+lJ 
LW*(I%)  -  LW4  (14+1) 


NEXT  1% 

PASSVFS ( IW4 )  =  *  • 
DNFL$  ( IW4)  -  ■  " 
NOUNPLS ( IW4 )  -  *  * 
UCWPLGS ( IW4 )  -  *  * 
LCLSFL*  ( IW4)  -  0 
LSENT4 ( IW% )  -  0 
PREPPL4 ( IW4 )  -  0 
LW4 ( IW* )  -  0 
GOTO  POSTPONO 

SING LEO: 

PASSVPS (1 )  -  *  * 
DNPL$(1)  ■  "  ‘ 
NOUNFLS ( 1)  -  "  * 
UCWPLGS (1)  -  "  * 
LCLSFL4  ( 1)  -  0 
LSENT4 ( 1 )  -  0 
PREPPL4  (1)  =»  0 
LW%  (1)  -  0 
POSTPONO: 

IF.IW4  >  0  THEN  IW4 
IP  D»  -  3  THEN  OUTO 


IW4-1 


/*  CHECK  ON  UNCOMMON  WORDS  AND  PRINT  IP  TABLE  IS  PULL  •/ 


IP  IDX»  <  200  THEN  OUTO 
GOSUB  UWL 
GOSUB  TOP 

OUTO:  IP  CWS-*Y"  THEN  CW$-"  * 

IF  WC14-0  THEN  LIST*,  CONSIS*  =  0 
RETURN 


/*  PRT_WDS  SUB.  RETURN  */ 


V 

•/  JM 


I 
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029290  /*  SUBROUTINE  TTL_PGE  SETS  UP  THE  HEADER  BLOCK  POR  THE  */ 

029300  /*  ANALYSIS.  THIS  BLOCK  SHOWS  WHAT  FILE  WAS  SELECTED  FOR  THE  */ 

029310  /*  ANALYSIS,  THE  TECHNICAL  WORD  LISTS  USED,  AND  THE  OPTIONS  */ 

029320  /*  SELECTED.  */ 

029330  /*  */ 

029340  /••**••*»»********•**»****»*******»****»*»»»**•»»**•»»**»*»*•••*•/ 
029350 

029360  TTL_PGE:  /*  SUBROUTINE  TTL_PGE  BEGINS  */ 

029370  C$-HEX<8001)  /*  TOP  OF  FORM  */ 

029380  WRITE  #12,  USING  DOG,  C$ 

029390  C$  -  HEX (0010)  /*  SKIP  10  LINES  */ 

029400  WRITE  #12,  USING  DOG,  C$ 

029410  CS  -  HEX (0001) 

029420  FOR  IQ»-1  TO  IE» 

029430  WRITE  #12,  USING  OOG1,  C$,  BUFFA*(IQ»J 

029440  NEXT  IQ« 

029450  RETURN 
029460  DOG:  »## 

029470 


029480  DOG1:  V*  ***** t »####(»»»###((«####«# t #»(»###(#( t« »«« f |( #t I ## ! 

029490  *##»###*(((##(##(((«##»«#( 


029500  ENDSUB:  RETURN 


/•  ANALYSIS  SUBROUTINE  RETURN  •/ 
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Title  Page  Set-Up  (TTLPGE) 

TTLPGE  in  library  CRES@SRC  is  the  BASIC  language  program  which  sets  up  the 
header  page  of  the  CRES  Analysis  report.  This  header  page  is  printed  at  the 
beginning  of  the  analysis  printout  and  includes  the  names  of  the  document 
analyzed,  any  technical  word  lists  utilized,  ana  the  options  selected  for 
inclusion  in  the  analysis.  A  header  page  is  included  in  the  sample  CRES 
output  found  in  appendix  0.  The  object  language  version  of  this  program  is 
TTLPGE  in  library  CRES@SAV. 


A  complete  program  listing  follows. 
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000010 
000020 
000030 
00  0040 
000050 
000060 
00007  0 
000080 
000090 
000100 
000110 
000120 
000130 
000140 
000150 
000160 
000170 
000180 
000190 
000200 
000210 
000220 
000230 
000240 
000250 
000260 
nnn?7n 
000280 
000290 
000300 
000310 
000320 
000330 
000340 
000350 
000360 
00037  0 
000380 
0003d 0 
000400 
0004  10 
000420 
000430 
000440 
000450 
000460 
00047  0 
000480 
0004RO 
0  00500 
000510 
000520 
000530 
000540 
000550 
000560 
00057  0 


*********  *  *************  *  ***********************  j  Jfvj 

/*  */  JM 

/*  SUBROUTINE  TTLPGE  SETS  UP  THE  HEADER  BLOCK  FOR  THE  */  RT 

/»  ANALYSIS.  THIS  BLOCK  SHOWS  WHAT  FILE  WAS  SELECTED  FOR  THE  */ 

/*  ANALYSIS,  THE  TECHNICAL  WORD  LISTS  USED,  AND  THE  OPTIONS  */ 

/*  SELECTED.  */ 

/*  */ 

/*#****♦*  ★**★★★***★*-***★**★*★*★**★********★*★-***“**-*★*★  ***★*•**★★**  j 

SUB  "TTLPGE"  AOOR (BUFFERS! ) ,PAG_T  I TLS ,DOCF ILS ,L  IBS .UOCVOLS ,RGL$ ,  I 
PREP_CNTJ,PASSV$,LNG_SEN$,LNG_PARJ,LNGWDS$,LNGSNTJ,NEG$,  I 

UNCOMJ , NUM  SU8ZS ,  INT  ANLJ.NPJ ,ADVFN$,PERS  SENT J ,LNG_CLS$ ,  ! 

TRNK_PVj,rrCFIL$()  ,rrCLIBS(),TECVOLS()  .IE'S) 

OIM  PAG  TITLJ60,00CFILJ04,LI8$01,D0CV0LJ6,RGLH,PREP_CNTJI 
DIM  PAS^VJl.LNG  SE  N$1 , LNG_PAR$1 .LNGWDSJ3 , LNGSNTJ2, NEGJ1 , UNCOMS 1 
DIM  NIW_SUBZJ1,TNT_ANLJ],NP$2,ADVFNJ1,PERS  SENT$1,LNG_CLS$1 
OIM  TRNK  PV$  1 ,  TECF  I  L$(7  ) 08 , TE C L  IB$ ( 7  ) 08 . TETVOLJ (7  ) 06 
DIM  BUFFTR} (40)77  ,OAT J8 ,D J08 ,T$05 

DAT J=  DATE  /*  FETCH  THE  DATE  */ 

DJ-  STR(0AT},3,2)t"/"lSTR(0AT},5,2 )t“/"!iSTR(DATJ,  1,2) 


T$=  STR(TIME, 
BUFFERS!  1 )  “  M : 

, 2 )«."  :  “&STR !T  IME  ,3 ,2) 

i 

l  M 

’ 

BUFFER$(2)  =  ".' 

l 

BUF  FER  S  ( 3 ) 

"K  TS 

buffers(4)=": 

'"8,  OS  8," 

*  II 

irk -kit  **  irk 

i 

CRES  ANALYSIS  I 

********  '  " 

BUFFERJ(5)«BUFFER$(2) 

8UFFER5(6)=BUFFER$( 1 ) 

BUFFER$(7 )=BUFFERJ(2) 

I  E  X=fl 

IF  PAG  TITLS  =  "  "  THEN  GERRY 

BUFFERT(8 )  = " :  TITLE:  "&  ST R ( PAG _ T I TLS, 1 , 60)  8,  "  1" 

BUFFERS (9  )  =BUEFERJ (?) 

I  EX~  1 0 

GERRY:  BUFFERSt  IEX)  =  “!  INPUT  FILE:  "&  DOCFILS  &  "  INPUT  LI1 

BKARY:  "&  I  IBS  8,  "  INPUT  VOLUME:  "  &  DOCVOLS  &  ''  !  " 

I E  X=  I E  X+ 1 

BUFFERS(IEX)  =BUFFERS(2)  /‘SKIP  A  LINE  */ 

I E  X=  I E  X+  1 

BUFFE RS ( I  E  X)  *  "I  OPTIONS  SELECTED  FOR  THIS  I 

ANALYSIS:  I" 

IEX=  IEX+1 

BUFFERS! IE  X)«" !  ===============  =  =  ====,  =  ===; 


IEX--IEX+1 

BUFFERS ( I E X) =BUFFER5(? )  /‘SKIP  A  LINE  */ 

I E  X=  I E  X+ 1 

BUFFERS!  IEX)-".1  REPORT  FINAL  READING  GRADE  LEVEL:  "8,  I 
RGL S  &  "  COUNT  PREPOSITIONS:  “  &  PREP  CNTS  &  "  I" 

I  EX- IE  X+l 

BUFFERS! I L  X)  ="  I  FLAG  PASSIVE  VOICE:  "8.  PASSVS  &  "  1 

FLAG  LONG  SENTENCES:  "8.  LNG  SENS  8,  "  " 

I E  X=  I E  X+ 1 

BUFFERS!  IEX)  =  "I  FLAG  DOUBLE  NEGA1IVES:  “8.  NEGS  8.  "  1 
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000580 
000590 
000600 
000610 
000620 
000630 
000640 
000650 
000700 
0007  1  0 
000720 
000730 
0007  40 
0007 50 
000760 
00077  0 
000780 
000790 
000800 
000810 
000820 
000830 
000840 
000850 
000860 
00087  0 
000880 
000890 
0009  00 
000910 
000920 
000930 
000940 
000950 
0009  60 
00097  0 
000980 
000990 
001000 
001010 
001020 
001030 
001040 
001050 
001060 


FLAG  UNCOMMON  WORDS:  “  4  UNCOMJ  4  "  “ 

IE  X=  IEX+1 

BUFF £R$ ( IEX)  =“!  INCLUDE  SUBSTITUTES:  “4  NUM  SUBZJ  4“ 
INTERIM  ANALYSIS:  "4  INT_ANLJ  4  “  1" 

I E  X=  I E  X+ 1 

BUFFERS!  I E X)  =  “ !  NUMBER  OF  PAGES  BETWEEN  REPORTS:  “4 
STR( NP$,  1,2)  4  "  CHECK  PERSONAL  SENTENCES:  "  4  PERS_SENTJ4M  !' 
IEX=IEX+1 

BUFFER$(lEX)  =  n;  CHECK  FOR  TRUNCATED  PASSIVE  VOICE:  M  4 
TRNK_PVS  4  "  1“ 

IEX-IEX+1 

IF  LNG  PARS  *  “Y"  THEN  8UFFERS!  IEX)=BUFFERS(2) 

IF  LNG  PAR$  =  “Y"  THEN  IEX=IEX+1 

BUFFERT(IEX)  =  u:  FLAG  LONG  PARAGRAPHS:  “4  LNG.  PARS  4“ 


I  E  X=  I E  X+ 1 

IF  LNG  PARJ="Y"  THEN  BUFFER}(  IE%)="I 


HOW  LONG? 


SENTENCES  =  "  4 


"  AND  TECL IBS! IDX)=“ 
"  THEN  NIL 


TECHNICAL  WORD  LISTS 


WORDS  =  “4  STR(LNGWDS£,  1 ,3 )  4n 
STR(LNGSNT$, 1 ,2)  4" 

IF  LNG  PAR$=" Y"  THEN  IEX=IEX+1 
BUFFERT(IEX)=BUFFERS(2) 

I  EX^IE  X+l 
2BT  X=0 

FOR  IDX=  1  TO  7 

IF  TECF  IL  J ( IDX)  =  "  "  AND 

TECVOLS!  I  DX)  =  "  "  THEN 

IF  ZBT%=1  THEN  ZOUND 
BUFFERS!  IEX)  ="I 
10:  I" 

IEX=  IEX+1 
BUFF  ER  J  ( I E  X)  =".' 


I E  X=  I E  %+ 1 

BUFFERJ(  I  EX)  =BUFFER$(2) 

I E  X=  I E  X+ 1 
ZBTX=1 

ZOUND:  BUFFERS!  IEX)  =  "I  FILE:  **4  STR(  TECF1LS!  1DX) ,  1 ,8)  4 

"  •  LIBRARY:  “  4  STR(TECLIB$(  IDX),  1 ,8)  4  "  VOLUME:  "  4 

S  TR  (  TEC  VOL  S  ( ID  X), 1,6)  4  "  I  “ 

IE  X=  IEX+1 
NIL:  NEXT  IDX 

BUFFERS!  1EX)=BUFFERS(2) 

IEX=IEX+1 

BUFFERS!  IEX)  =  BUFFERS(1) 

END 


-  *  v'  *  *  +  * 
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Copy  Word  Lists  To  Tape  (CRESTAPE) 

CRESTAPE  in  library  CRES0SRC  is  the  BASIC  language  program  which  copies 
one  or  more  of  the  CRES  word  lists  to  tape.  The  object  language  version  is 
CRESTAPE  in  library  CRES@SAV. 

This  program  requires  the  user  to  specify  the  word  list  to  be  copied  and 
the  name  or  number  of  the  tape  where  the  list  is  to  be  written.  If  the  word 
list  does  not  exist,  or  if  there  is  no  available  tape  drive,  an  appropriate 
message  is  displayed  on  the  screen.  If  the  word  list  does  exist  and  there  is 
an  available  drive,  but  no  tape  mounted,  the  user  will  be  prompted  to  mount  a 
tape.  If  a  tape  is  already  mounted,  the  program  will  copy  the  specified  word 
list  to  the  tape.  On  completion  of  the  copy,  the  program  returns  to  the  word 
list  specification  screen  to  enable  the  user  to  write  another  word  list  to 
tape  or  to  exit  the  Copy  Word  Lists  to  Tape  option.  The  program  requires  that 
the  word  lists  to  be  copied  be  specified  one  at  a  time.  Each  given  list  is 
copied  successively  to  tape,  not  overwriting  the  previous  word  list,  provided 
they  are  done  in  the  same  session.  However,  if  the  program  is  exited  and  then 
re-entered,  the  tape  will  be  regarded  as  blank  and  word  lists  will  be  written 
starting  at  the  beginning  of  the  tape,  writing  over  any  previous  word  lists  or 
other  data. 

Figure  5  presents  a  flowchart  of  the  program  to  copy  word  lists  to  tape. 

A  complete  program  listing  follows. 


DECLAIM  VARS 
A  MTIAUZE 
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Consecutive  File  CRESTAPE  in  Library  CRES0SRC  on  Volume  CRES01 

000020 /****************************************************** ****** ****/rj 
000040/*  */RT 
000060/*  PROGRAM:  BULDTAPE  DATE  REVISED:  11/25/83  BY:  RT  */RT 
000080/*  */RT 
000100/*  THIS  PROGRAM  READS  THE  DISK  FILE  AND  PUTS  THE  DATA  ON  TAPE.  */RT 
000120/*  */RT 
0001 40 /******************■************■*********'***■*’*******************'** /RT 
000160  RI 
000180  DIM  01SK_BUF4$220,DISK_BUF1 $50,01  SK  BUF2$80,D1SK_BUF3S190  JM 
000200  DIM  TAPE  I  NFO$255,  FINDTAPE$24,  TV0LJ6,  0PENX(2),  RET$5  RT 
000220  RT 
000240/*  This  is  the  CRES  TAPE  BUILDING  SUBSYSTEM  PROGRAM  */  RT 
000260/*  */  RT 
000280/*  AUTHOR:  Rose  Tank  */  RT 
000300/*  Date:  November  25,  1983  */  RT 
000320/*  */  RT 
000340/*  This  program  copies  a  disk  data  file  on  to  a  tape  for  */  RT 
000360/*  distribution  to  the  CRES  users.  */  RT 
000380  RT 
000400DIM  DFILE$8,DLIB$8,DV0L$6,USER$3  RT 
000420DIM  HEADER$27f,C0DE$l,L$l,V$l,B$l,Ctl,DH,EH,ER$40,F$40  RT 
000440F$-  "Filename  not  found  on  (library/volume)."  RT 
000460SEQN0%=0  RT 
000480CALL  "EXTRACT"  ADDR( "  IV" ,DV0L$,"ID" ,USER$, "IL" , DL 1 B$)  RI 
000500  RT 
000520HEADERS  ="CRES  DISK  TO  TAPE  SUBSYSTEM"  RT 
000540NEXTFILE :  RT 
000560  DFILES="  " : G$=HEX ( 8 1 )  RT 
000580  ERS="  ":Lf*HEX(61)  RT 
000600  V$=HEX (81) :  E$=HEX(80)  RT 
000620FILMNU:  RT 
000640DI M  ENTERS  05  RT 
000660DIM  PF 16$  04  RT 
00  0  680ENTERS  =  "ENTER"  RT 
000700PF 1 6$  ="PF16"  RT 
000720ACCEPT  -  t  RT 
000740  AT  (01,01),  I  JM 
000760"CRES:  Disk  to  Tape  (Build  Tape  Data  File  S1JM 
000780election  Screen)",  UM 
000800  AT  (02,01),  UM 

000840  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =  =",  UM 
000860  AT  (04,21),  IRT 
000880"We lcome  to  the",  IRT 
000900  AT  (04,36),  FAC(HEX  (85) ) ,  HEADERS  ,  CH(27),  '.RT 
000920  AT  (07,02),  '.RT 
000940"  This  Tape  Program  allows  you  to  copy  the  word  lists  to  tape  fr'UM 
000960om  the  disk.",  UM 
000980  AT  (08,02),  IRT 
001000"  Please  specify  below  the  list  you  want  to  copy  and  the  Tape  Na'.JM 
001020me  or  Number.",  UM 
001140  AT  (13,30),  UM 
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001 1 60"F i  le  =",  1RT 
001180  AT  (13,44),  FAC(HEX(81 ) ) ,  DF1LE$  ,  CH(08),  UM 
001200  AT  (14,30),  UM 
'001 220"L  ibrary  =u,  IRT 
001240  AT  (14,44),  FAC(HEX(81 )),  DL I B$  ,  CH(08),  '.JM 
001260  AT  (15,30),  IJM 
001 280"Vo  lume  =",  IRT 
001300  AT  (15,44),  FAC(HEX(81 ) ) ,  DVOLJ  ,  CH(06),  UM 
001320  AT  (17,27),  UM 
001340"Tape  Name  or  Number  =",  IRT 
001360  AT  (17,49),  FAC(HEX(81 ) ),  TVOLS  ,  CH(06),  '.JM 
001380  AT  (19,17),  FAC(E$),  ER$  ,  CH(SO),  IRT 
001400  AT  (22,29),  I JM 
001420"  Press",  IRT 
001440  AT  (22,36),  F AC ( HE X ( 85 ) ) ,  ENTERS  ,  CH(05),  ’.JM 
001460  AT  (22,42),  1 JM 
00 1480" to  continue",  IRT 
001500  AT  (23,22),  '.RT 
001  S20"Press" ,  .'RT 
001540  AT  (23,28),  FAC(HEX (84) ) ,  PF  1 6$  ,  CH(04),  IRT 
001560  AT  (23  33),  IRT 
001580"to  return  to  the  Master  Menu",  IRT 
001 600KEYS( BI N (0 )&B I N ( 1 6 ) &B I N ( 32 ) ) .  IRT 
0016200N  ( BI N( 1 6 ) &H1 N ( 32 ) )  GOTO  OUT, OUT  RT 
001640  RT 
001660  SELECT  # 1 ,  "01 SKFI LE" ,VARC , INDEXED, RECSI ZE  =  50  ,  ’.Rl 
001680  KEYPOS3 1 ,  KEYLEN=20,  IOERR  GOTO  I0ERR1  RT 
001700  SELECT  #2, "DISKFILE",VARC, INDEXED, RECSIZE=80  ,  ‘.RT 
00  1  720  KEYPOS=  1 ,  KEYLEN=20,  IOERR  GOTO  I0ERR1  RT 
001740  SELECT  #3 ,  "01  SKF ILE "  ,VARC ,  I NDEXED.RECSIZE3  1 95,  '.JM 
001760  KEYPOS- 1 ,  KEYLEN=20,  IOERR  GOTO  I0ERR1  RT 
001  780  SELECT  #4, "DI  SKF  ILE"  ,VARC,  INDEXED, RECSIZE=220,  '.JM 
001800  KEYPOS3 1 ,  KEYLEN=20,  IOERR  GOTO  I0ERR1  JM 
001820  RT 
001840/*  SEE  IF  THE  SPECIFIED  FILE  EXISTS  */  RT 
001860  '  RT 
00 1 B80CAL  L  "L IMI  TS"  (  DF  I  LE$,  DL  I  B$  .OVOLS, CODES, ERS)  RT 
001 9001 F  CODES="Y"  THEN  III  RT 
001 920  IF  COOES="N"  THEN  GOSUB ' 7 (F$,HEX (9 1 ) .HEX (81 ) ,HEX(81 ) )  RT 
001940IF  CODES- "V"  THEN  GOSUB' 7(STR(ER$,3) .HEX ( 81 ) .HEX (81 ) .HEX (91) )  RI 
001 960 IF  CODES="L "  THEN  GOSUB ' 7 (STR( ERS.3) ,HEX(81 ) ,HEX(91 ) .HEX (81 ) )  RT 
001 9801  F  CODE$="E"  THEN  GOSUB'  7(STR(ER$,3) , HEX ( 81 ) , HEX ( 81 ) , ME X ( 8 1 ) )  RT 
002000 GOTO  FILMNU  RT 
002020  RT 
002040ERS="  "  :GS,LS,VS,ESsHEX(8D)  RT 
002060ZZZ:  CALL  "READFDR"  ADDR(  DFILEJ,  DUBS,  DVOLS,  0*,"RS"  ,  RSI  Z5t,RET%)  RT 
002080  RT 
002100  IF  RSI Z5t < 5 1  THEN  K-l  RT 
002120  IF  RSIZO50  AND  RSIZ%<81  THEN  K=2  RT 
002140  IF  RSI ZS>80  AND  RSI Z%< 191  THEN  K»3  JM 
002160  IF  RSI  Z%>1 90  THEN  K=4  JM 
002180  RT 
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002200  SELECT  #! 

002220  DENS  I I  Y= 

002240 

002260  SELECT  »■ 

002280  DENSI TY  = 

002300 

0023  20  SELECT  # 

002340  DENSI  IV* 

002360 

002380  SELECT  # 

0024  0  0  DENSITY5 

002420 

002440  SEQNOX*  SEQNOX+ 


SELECT  #5, "  I APEF  IL1 "  .TAPE  ,NL  ,RECSI  ZE=50  ,  BLKS1  ZE=4000, 
DENSI T Y= 1 600, 1 OERR  GOTO  I0ERR2 


SELECT  #6,  "TAPEFIL2"  .TAPE ,NL .RECSIZE =80  , BLKSI ZE =4000, 
DENSITY5 1600, I OERR  GOTO  I0ERR2 

SELECT  #  7,"  T  APEFIL3"  ,T  APE  ,NL  ,RLCS1  ZE  =  1 90,  BLKS1 ZE -3800, 
DENSI  1Y=1600,I0ERR  GOTO  I0ERR2 

SELECT  #8,  "TAPEFIL4" .TAPE ,NL , RECSIZE -220, BLKSI ZE =4400, 
DENSITY=1600,I0ERR  GOTO  I0ERR2 


002460/*  'extract'  volune  name  and  number  of  tape  drives  -/ 
002480  TAPE  1  NFO$=HE  X  (02FU) 

002500  CALL  "EXTRACT"  ADOR(  “I V"  ,  DVOLS , "OL"  .TAPE I  NF 0$) 

002520 

002540  I  =V  Al.  (  ST  R  ( I  APE  I  NF  0$  ,2 ) ) 

002560  UEVN0%=0 
00  2  580  SAVENOX'O 

002600  FOR  3=1  1 Q  I 

(X12620  F  INDTAPEt  -  STR  (TAPEI  NFO^.?*  J  ,  1) 

002640  CALL  "EXTRACT"  ADOR("()  "  ,F  INDIAPES) 

002660  IF  STR(FINDTAPE$,9,6)="  "  AND  SAVEN0%=0  THEN 

002680  SAVEN0%  VAL  (  STR  (  TAPE  INFOS, 2*J  ,  1 ) ) 

002700  IT  SIR (F  1 N01  APE$,  9,6 )  OTV0LS  THEN  2760 

002720  DCVNO%=VAL  (STR(  TAPE  I  NT  OS  ,2*3 , 1 ) ) 

002740  3  =  1 

002760  NEXT  J 

002780  IF  DEVNIIXOO  IMF  N  3080 
002800 

002820  IF  SAVEN0*<X>  THEN  2920 

002840PR I  NT  AI  (22, I , ); BH  L ; "A  1 1  your  tape  drives  are  busy  OR 
002860t  Tape  Name  ( or  Number)."  :  INPUT  "PRE^s  ENTER  ",RETS 


00,  IJM 

RT 
RT 

100,  13M 

RT 
RT 

100,  IJM 

RT 
JM 

100,  IJM 

JM 
R! 
RT 
RT 
RT 
RI 
RT 
RT 
RT 
RT 
RT 
RT 
RT 
I  RT 
RT 
JM 
RT 
RT 
RT 
JM 
RI 
JM 

incorrec  I  RT 
RI 


002880 
002900 
002920 
002940 
002960 
002980 
003000 
00  3020 
00  30  40 
00  3060 
003080 
003100 
0031  20 
003140 
003160 
003180 
003200 
003220 


GOTO  CLSFL 


DEVNO%=SAVEN<)% 

CALL  "MOUNT"  ADDR(SAVENOX,TVOLS,"N"  ,"E"  ,“R"  ,"N"  ,"B"  ,"  ",R%) 
IF  R%=0  THEN  30  8  0 

PRINT  AT (22, 1 , ) ; BELL ; “I  ape  Mount  failed  ";R% 

PRINT  AT  (23. 1 )  ;“louch  'ENTER'  to  return  to  menu. 


PRINT  AT (22, 1 , ) ; BELL ; " 
PRINT  AT (23, 1 ) ;"louch 
INPUT  RETS 
GOTO  CLSFL 


IF  OPEN%( I )  -  1  THEN  CLOSE  UK 

OPEN  NOGETPARM  »K,  INPUT,  FILE=OFILES,  L 1  BRARY=DL  I  BS , 
VOLUME  =I)V()l  S 
OPENX( 1)  =  1 

IF  OPEN%( 2 )  =  1  THEN  CLOSE  #K*4 

OPEN  NOGETPARM  # K+4,  OUTPUT,  VOLUME  =TVOL S,  F  lLESEQ  =  SEQNOt 
0PEN%{2 )  =  1 
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GOTO  3500 
GOTO  3500 
GOTO  3500 
GOTO  3500 


1  THEN  CLOSE  #K 
1  THEN  CLOSE  #K*4 


003240 

00326001  SPLAY 

003280  AT  (01,03), 

003300  "CRES  Subsystem:  Build  Tape  Data  File", 

003320  "  (Writing  to  Tape)", 

003340  AT  (02,03), 

003380=============", 

003400  AT (09,21 ) , 

003420  "Writing  to  the  following  Tape  :  ", 

003440  AT  (11,25), 

003460  "  VOLUME  ==>  '",TVOL$,“ 

003480 

003500  ON (K )  GOTO  3520,3540,3560,3570 
003520.  READ  #K,DISK_BUF 1$,  EOD  GOTO  CLSFL  :GOTO  3580 

003540  READ  #K,DISK_8UF2$,  EOD  GOTO  CLSFL  :GOTO  3580 

003560  READ  #K,DISK  BUF3$,  EOD  GOTO  CLSFL  :GOTO  3580 

003570  READ  IK.DISK  BUF4J,  EOD  GOTO  CLSFL  :GOTO  3580 

003580  ON ( K )  GOTO  3^00,3620,3640,3660 

003600  WRITE  #K+4,  DISK_BUF1$,  DATA  GOTO  I0ERR2  :GOTO  3500 

003620  WRITE  #X+4,  DISKBUF2S,  DATA  GOTO  I0ERR2  :GOTO  3500 

003640  WRITE  #K+4,  D1SKBUF3J,  DATA  GOTO  I0ERR2  :GOTO  3500 

003660  WRITE  #K+4,  DISK_BUF4$,  DATA  GOTO  I0ERR2  :GOTO  3500 

00  3  680 

003700CLSFL :  IF  OPENX(l)  =  1  THEN  CLOSE  #K 

003720  IF  0PENS(2)  =  1  THEN  CLOSE  #K*4 

003740  MAT  OPEN%=ZER 

003760  GOTO  NEXTFILE 

003780 

0038000UT :  CALL  "DISMOUNT"  AODR(TVOL$,"T" ,R%) 

003820  END 

003840 

003860/*  THIS  FUNCTION  PRINTS  OUT  ERROR  MESSAGES  AND  */ 

003880/*  SETS  UP  FLASHING  FAC'S  IN  APPROPRIATE  PLACES  */ 

003900DEF  FN'7(ER$,BJ,CS,D$) 

003920  PRINT 

003940  E$=HEX(94) 

003960  G$=B$ 

003980  L$=C$ 

004000  V$=D$ 

004020RE  TURN 
004040 

0040601  OF RR1 :  PRINT  PAGE,  AT (0 1 ,01 ) ,  "I/O  ERROR  ON  DISK  DATA  FILE 
004080F ILE  STATUS  IS  :  " ; F S ( # I ) 

004100  STOP  "  PRESS  ENTER  TO  RETURN  TO  PREVIOUS  EtNU" 

00  41  20  GOTO  CLSFL 

004140 

0041601  0ERR2 :  PRINT  PAGE,  AT  (01 , 01 ) ,  "I/O  ERROR  ON  TAPE  DATA  FILE 
004180F  ILE  STATUS  IS  :  ";FS(#K) 

004200  STOP  "  PRESS  ENTER  TO  RETURN  TO  PREVIOUS  MENU" 

004220  GOTO  CLSFL 

***  End  of  Listing  ********************************************** 


IF  OPENX(l)  = 
IF  OPENS (2 )  = 
MAT  OPEN%=ZER 
GOTO  NEXTFILE 


CALL  "DISMOUNT"  AOOR(TVOL$,"T"  ,R%) 
END 


RT 

'.RT 

!RT 

'.RT 

:rt 

1RT 

======:rt 

'.RT 

:rt 

'.RT 

:rt 

RT 

RT 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

JM 

RT 

RT 

JM 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

RT 

#1.  :rt 

RT 

RT 

RT 

RT 

#2.  '.RT 
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APPENDIX  A 

The  following  provides  definitions  of  the  ORES  word  lists,  and  the  control 
file  for  each.  Other  lists  can  be  created  with  different  names  and  used  in 
the  ORES  analysis,  but  the  format  for  each  would  be  identical  to  those  listed 
below. 

CMNWDLST  This  is  the  Common  Word  List  used  in  the 

CRES  analysis. 

WROSBLST  This  is  the  Word  Substitute  List  used  in 

the  CRES  analysis. 

PHRSBLST  This  is  the  Phrase  Substitute  List  used 

in  the  CRES  analysi s. 

TECWDLST  This  is  a  Technical  Word  List  used  in 

the  CRES  analysis.  There  can  be  any 
number  of  these  lists  created,  each  with 
a  different  name.  Up  to  seven  may  be 
used  in  any  given  analysis. 

ABACGLOS  This  is  the  Abbreviation/Acronym 

Glossary  used  in  the  CRES  analysis. 

GLOSSARY  This  is  the  Reference  Glossary.  The 

words  contained  on  this  list  are  not 
used  in  the  CRES  analysis. 
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CONTROL  FILE  UTILITY  PROGRAM 
DATE:  01/07/85  TIME:  10:42 
List  of  Control  File 

Control  File  Characteristics 

File  Name:  CMNWDLST 

Records  are  fixed-length,  record  size  is  0040 
File  organization  is  indexed,  with  key  field  =  WORD 


OPERATION  ALLOWED? 

File  report  YES 

Record  update  YES 

Record  deletion  YES 

Description:  THIS  FORMAT  IS  FOR  THE  RECORDS  OF  THE  COMMON  WORD  LIST 

ASSOCIATED  WITH  CRES 


Field 

Name 

Start 

Posn 

Int 

Fmt 

Int 

Len 

Ext 

Len 

Rep 

Len 

Dec 

Pos 

Occur 

Count 

Report/  Blank 
Update  After 

Date/ 

Time 

Cum 

Field 

Val id- 

at  Ion 

Allas  Name 

WORD 

l 

C 

20 

20 

20 

0 

1 

R/U 

YES 

WORD 

PRTOPSPC 

21 

C 

1 

1 

1 

0 

1  , 

R/U 

YES 

part  of  Speech 

PPART 

22 

c 

1 

1 

1 

0 

1 

R/U 

YES 

past  PARTICIPLE 

NEGATIVE 

23 

c 

1 

1 

1 

0 

1 

R/U 

YES 

NEGATIVE  FLAG 

TOBE 

24 

c 

1 

l 

1 

0 

1 

R/U 

YES 

TO  BE  FLAG 

FILLER 

25 

c 

l 

1 

1 

0 

1 

R/U 

YES 

ROOTWORD 

26 

C  ' 

l 

l 

l 

0 

1 

R/U 

YES 

ROOT  WORD  FLAG 

FILLER2 

27 

c 

1 

1 

1 

0 

1 

R/U 

YES 

PROTECT 

28 

c 

3 

3 

3 

0 

1 

R/U 

YES 

PROTECTION  BYTES 

FILLER3 

31 

c 

10 

10 

10 

0 

R/U 

YES 
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CONTROL  FILE  UTILITY  PROGRAM 
DATE:  01/07/85  TIME:  10:43 
List  of  Control  File 

Control  File  Characteristics 

File  Name:  WRDSBLSr 

Records  are  fixed-length,  record  size  is  0080 
File  organization  is  indexed,  with  Key  field  =  WORD 


OPERATION  ALLOWED? 


File 

report 

YES 

Record 

update 

YES 

Record 

deletion 

YES 

Description:  THIS  IS  THE  RECORD  FORMAT  FOR  THE  WORD  SUBSTITUTION  LIST 

ASSOCIATED  WITH  CRES 


Field 

Name 

Scart 

Posn 

Znt 

Frnt 

InC 

Len 

Ext 

Len 

Rep 

Len 

Dec 

Pos 

Occur 

Count 

Report/ 

Update 

Blank 

After 

Date/ 

Time 

Cum 

Field 

Valid- 

at  ion 

Alias  Name 

WORD 

1 

C 

20 

20 

20 

0 

1 

R/U 

YES 

WORD 

SUB ONE 

21 

c 

20 

20 

20 

0 

1 

R/U 

YES 

FIRST  SUBSTITUTE 

SUBIVO 

41 

c 

15 

16 

15 

0 

1 

R./U 

YES 

SECOND  SUBSTITUTE 

PRTOS PC 

56 

C 

l 

1 

1 

0 

1 

R/U 

YES 

PART  OP  SPEECH 

ppfl 

5? 

- 

* 

l 

1 

3 

1 

R/U 

YES 

PAST  PARTICIPLE 

N'LMFZ. 

5H 

c 

L 

1 

1 

0 

1 

R/U 

YES 

NEGATIVE  FLAG 

??  te/t 

59 

c 

3 

3 

3 

0 

1 

R./U 

YES 

PROTECTION  BYTES 

KILLER 

6  2 

1  9 

19 

19 

0 

1 

R/U 

YES 
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CONTROL  FILE  UTILITY  PROGRAM 
DATE:  01/07/85  TIME:  10:42 
List  of  Control  File 

Control  File  Character istics 

File  Name:  PHRSBLST 

Records  are  fixed-length,  record  size  is  0070 
File  organization  is  indexed,  with  key  field  -  WORD 


OPERATION 
File  report 
Record  update 
Record  deletion 


ALLOWED? 

YES 

YES 

YES 


Description:  THIS  IS  THE  RECORD  FORMAT  FOR  THE  PHRASE  SUBSTITUTION  LIST 

ASSOCIATED  WITH  CRES 


Field  Start  Int  Int  Ext  Rep  Dec  Occur  Report/  Blank  Date/  Cum  Valid- 

Name  Posn  Frat  Len  Len  Len  Pos  Count  Update  After  Time  Field  ation 


WORD 

i 

c 

24 

24 

24 

0 

1 

R/U 

YES 

SUBONE 

25 

c 

20 

20 

20 

0 

I  . 

R/U 

YES 

SUBTWO 

45 

c 

20 

20 

20 

0 

1 

R/U 

YES 

PROTECT 

65 

c 

3 

3 

3 

0 

1 

R/U 

YES 

FILLER 

68 

c 

3 

3 

3 

0 

1 

R/U 

YES 

Alias  Name 
PHRASE 

FIRST  SUBSTITUTE 
SECOND  SUBSTITUT 


PROTECTION  BYTES 
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CONTROL  FILE  UTILITY  PROGRAM 
DATE:  01/07/85  TIME:  10:42 
List  of  Control  File 

Control  File  Characteristics 

File  Name:  PHRSBLST 

Records  are  fixed-length,  record  size  is  0070 
File  organization  is  indexed,  with  key  field  »  WORD 


OPERATION 
File  report 
Record  update 
Record  deletion 


ALLOWED? 

YES 

YES 

YES 


Description:  THIS  IS  THE  RECORD  FORMAT  FOR  THE  PHRASE  SUBSTITUTION  LIST 

ASSOCIATED  WITH  CRES 


Field  Start  Int  Int  Ext  Hep  Dec  Occur  Report/  Blank  Date/  Cum  Valid- 


Name 

Posn 

Fmt 

Len 

Len 

Len 

Pos 

Count 

Update 

After  Time  Field 

at  ion 

Alias  Name 

WORD 

1 

C 

24 

24 

24 

0 

1 

R/U 

YES 

PHRASE 

SUBONE 

25 

C 

20 

20 

20 

0 

1  , 

R/U 

YES 

FIRST  SUBSTITUTE 

SUBTWO 

45 

C 

20 

20 

20 

0 

1 

R/U 

YES 

SECOND  SUBSTITUTE 

PROTECT 

65 

C 

3 

3 

3 

0 

1 

R/U 

YES 

PROTECTION  BYTES 

PILLER 

68 

C 

3 

3 

3 

0 

1 

R/U 

YES 
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CONTROL  PILE  UTILITY  PROGRAM 
DATE:  01/07/85  TIME:  10:0 
List  of  Control  Pile 

Control  Pile  Characteristics 

File  Name:  TECWDLST 

Records  are  fixed-length,  record  size  is  0040 
Pile  organization  is  indexed,  with  Key  field  «  WORD 


Description: 


OPERATION 

Pile  report 

Record  update 
l 

Record  deletion 
THIS  IS  THE  RECORD  FORMAT 
ASSOCIATED  WITH  CRES 


ALLOWED? 

YES 

YES 

YES 

THE  TECHNICAL  WORD  LISTS 


Field  Start  Int  Int  Ext  Rep  Dec  Occur  Report/  Blank  Date/  Cum  Valid- 


Name 

Posn 

Fmt 

Len 

Len 

Len 

P03 

Count 

Update 

After  Time  Field 

at  ion 

Alias  Name 

WORD 

1 

C 

20 

20 

20 

0 

1 

R/U 

YES 

WORD 

PRTOFS  PC 

21 

C 

l 

1 

1 

0 

1  , 

R/U 

YES 

PART  OP  SPEECH 

PPART 

22 

c 

1 

l 

1 

0 

1 

R/U 

YES 

PAST  PARTICIPLE 

NEGATIVE 

23 

c 

1 

1 

1 

0 

1 

R/U 

YES 

NEGATIVE  FLAG 

TOBE 

24 

c 

1 

1 

1 

0 

1 

R/U 

YES 

FORM  OP  TO  BE  FLAC 

PILLER 

25 

c 

1 

l 

1 

0 

1 

R/U 

YES 

HOOTWOKD 

26 

c 

1 

1 

1 

0 

1 

R/U 

YES 

HOOT  WORD  FLAG 

MTWU 

27 

c 

1 

l 

1 

0 

1 

R/U 

YES 

MANDATORY  TECHNIC/ 

PROTECT 

28 

c 

3 

3 

3 

0 

1 

R/U 

YES 

PROTECTION  BYTES 

FILLER2 

31 

c 

10 

10 

10 

0 

1 

R/U 

YES 
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DATE:  01/07/8S  TIME:  10:38 
List  of  Control  File 

Control  File  Characteristics 

File  Name:  ABACGLOS 

Records  are  fixed-length,  record  size  is  0190 
File  organization  is  indexed,  with  key  field  =  WORD 


OPERATION  ALLOWED? 

Pile  report  YES 

Record  update  YES 

I 

Record  deletion  YES 

Description:  THIS  IS  THE  RECORD  FORMAT  FOR  THE  ABBREVIATION/ACRONYM 

GLOSSARY  ASSOCIATED  WITH  CRES 


Field 

Name 

Start 

Posn 

Int 

Fmt 

Int 

Len 

Ext 

Len 

Rep  Dec 
Len  Pos 

Occur  Report/  Blank 
Count  Update  After 

Date/ 

Time 

Cum 

Field 

Valid¬ 

ation 

Alias  Name 

WORD 

1 

C 

20 

20 

20 

0 

1 

R/U 

YES 

ABBREV/ACRONYM 

TYPE 

21 

C 

1 

1 

1 

0 

1  , 

R/U 

YES 

B-ABBREV, C -ACRONYM 

DEF1 

22 

c 

55 

55 

55 

0 

1 

R/U 

YES 

DEFINITION  LINE  1 

DEF2 

77 

c 

55 

55 

55 

0 

1 

R/U 

YES 

DEFINITION  LINE  2 

DEF3 

132 

c 

55 

55 

55 

0 

1 

R/U 

YES 

DEFINITION  LINE  3 

FILLER 

187 

c 

4 

4 

4 

0 

1 

R/U 

YES 
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APPENDIX  B 

The  following  is  a  list  of  the  included  programs  and  data  files,  and  the 
library  in  which  they  reside: 


F i 1 e  N  ame 

Library 

LIMITS 

@SY  SSAVO 

FINDUSER 

@SYSSAV@ 

ABBRELST 

CRESOBAK 

ADMCLER 

CRESOBAK 

AIREQUI 

CRESOBAK 

CMNWDLST 

CRES@6AK 

COMMNAV 

CRESOBAK 

ELIMSPCH 

CRES0BAK 

GENELCT 

CRESOBAK 

GLOSSARY 

CRES0BAK 

HMELCT 

CRESOBAK 

PHRSBLST 

CRESOBAK 

PROPENG 

CRESOBAK 

WRDSBLST 

CRESOBAK 

WSCONT 

CRESQBAK 

ABACGLOS 

CRES0CTL 

CMNWDL ST 

CRES0CTL 

GLOSSARY 

CRES0CTL 

PHRSBL ST 

CRESOCTL 

FECWDLST 

CRESQCTL 

WRDSBL ST 

CRESOCTL 

ABBRELST 

CRESQDAT 

ADMCLER 

CRES0DAT 

AIREQUI 

CRESODAT 

CMNWDLST 

CRES0DAT 

COMMNAV 

CRES0DAT 

ELIMSPCH 

CRES0DAT 

GENELCT 

CRESODAT 

GLOSSARY 

CRESODAT 

Description 


Checks  for  the  existence  of  specific  files 
Finds  a  specific  user  logged  on  the  system 
Backup  copy  of  Abbreviation/Acronym  list 
Backup  copy  of  Administrative/Clerical 
Technical  Word  List 

Backup  copy  of  Aircraft  Equipment  Technical 
Word  List 

Backup  copy  of  the  Common  Word  List 
Backup  copy  of  the  Communication/Navigation 
Technical  Word  List 

Backup  copy  of  a  table  of  characters  to  be 

eliminated  from  documents  before  analysis 

Backup  copy  of  the  General  Electronics 

Technical  Word  List 

Backup  copy  of  the  Glossary 

Backup  copy  of  the  Hull,  Mechanical,  and 

Electrical  Technical  Word  List 

Backup  copy  of  the  Phrase  Substitution  List 

Backup  copy  of  the  Propulsion  Engineering 

Technical  Word  List 

Backup  copy  of  the  Word  Substitution  List 
Backup  copy  of  the  Weapon  Systems  Control 
Technical  Word  List 

Control  file  for  the  Abbreviation/Acronym  List 
Control  file  for  the  Common  Word  List 
Control  file  for  the  Glossary 
Control  file  for  the  Phrase  Substitution  List 
Control  file  for  the  Technical  Word  Lists 
Control  file  for  the  Word  Substitution  List 
Abbrevi at i on/Ac ronyrn  List 
Administrative/Clerical  Technical  Word  List 
Aircraft  Equipment  Technical  Word  List 
Common  Word  List 

Communications/Navigation  Technical  word  List 
Table  of  characters  to  be  eliminated  from 
documents  before  analysis 
General  Electronics  Technical  Word  List 
Technical  Word  Glossary 
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HMELCT 

CRES@DAT 

Hull,  Mechanical,  and  Electrical  Technical 

Word  List 

PHRSBLST 

CRES0DAT 

Phrase  Substitution  List 

PROPENG 

CRES@OAT 

Propulsion  Engineering  Technical  Word  List 

WRDSBLST 

CRESODAT 

Word  Substitution  List 

WSCONT 

CRES@DAT 

Weapon  Systems  Control  Technical  Word  List 

ANAL D ISP 

CRES@PRC 

Procedure  Language  routine  to  display 
completed  analyses  at  the  terminal 

ORES 

CRES@PRC 

Procedure  Language  routine  that  serves  as  the 
main  driver  for  the  ORES  system 

CRES0BCG 

CRES@PRC 

Procedure  Language  routine  that  serves  as  a 
driver  for  the  Maintain  Glossaries  subsystem 

CRES@CMW 

CRES@PRC 

Procedure  Language  routine  that  serves  as  a 
driver  for  the  Create/Maintain  Common  Word 

List  subsystem 

CRES0SWL 

CRES@PRC 

Procedure  Language  routine  that  serves  as  a 
driver  for  the  Create/Maintain  Technical  Word 
List  subsystem 

CRES@WSL 

CRES0PRC 

Procedure  Language  routine  that  serves  as  a 
driver  for  the  Create/Maintain  Substitution 
Lists  subsystem 

D I SP  FILE 

CRESOPRC 

Procedure  Language  routine  to  display  selected 
word  lists  at  the  terminal 

ANALYSIS 

CRESOSAV 

The  object  code  for  the  Analysis  Program 

CRES@BCG 

CRESOSAV 

The  object  code  for  the  Maintain  Abbreviation/ 
Acronym  Program 

CRES0BCP 

CRES0SAV 

The  object  code  for  the  Print  Abbreviation/ 
Acronym  Program 

CRESOCPA 

CRES0SAV 

The  object  code  for  the  Print  Common  Words  By 
Attribute  Program 

CRES^CWL 

CRES@SAV 

The  object  code  for  the  Create/Maintain  Common 
Word  List  Program 

CRESICWP 

CRESOSAV 

The  object  code  for  the  Print  Common  Word  List 
Program 

CRESOERW 

CRESOSAV 

The  object  code  for  the  Expand  Root  Words 
Program 

CRESPPSL 

CRES<?SAV 

The  object  code  for  the  Create/Maintain  Phrase 
Substitution  List  Program 

CRESOPSP 

CRESOSAV 

The  object  code  for  the  Print  Phrase 
Substitution  List  Program 

CRES0RND 

CRESOSAV 

The  object  code  for  random  number  generation 

CRESOSBP 

CRESOSAV 

The  object  code  for  the  Print  Combination  of 
Word  and  Phrase  Substitution  Lists  Program 

CRESOTPA 

CRES@SAV 

The  object  code  for  the  Print  Technical  Words 
by  Attribute  Program 
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CRES@TWL  CRESOSAV  The  object  code  for  the  Create/Maintain 

Technical  Word  List  Program 

CRESOTWP  CRESOSAV  The  object  code  for  the  Print  Technical  Word 

List  Program 

CRESOWSL  CRESOSAV  The  object  code  for  the  Create/Maintain  Word 

Substitution  List  Program 

CRESOWSP  CRESOSAV  The  object  code  for  the  Print  Word 

Substitution  List  Program 

CRESGLOP  CRES@SAV  The  object  code  for  the  Glossary  Print  Program 

CRESGLOS  CRES@SAV  The  object  code  for  the  Maintain  Glossary 

Program 

CRESTAPE  CRES@SAV  The  object  code  for  the  Word  List  to  Tape 

Program 

The  object  code  for  a  logoff  graphics  program 


CRSEN1 


CRES0SAV 
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APPENDIX  C 

There  are  three  categories  of  programs  in  the  CRES  system  that  are 
essentially  the  same  in  all  the  subsystems.  They  are  the  programs  to  create 
and/or  maintain  a  word  list  or  glossary,  the  programs  to  print  a  word  list  or 
glossary,  and  the  programs  to  print  a  word  list  or  glossary  according  to  a 
specified  attribute  or  combination  of  attributes.  This  appendix  presents  the 
basic  flowcharts  for  these  three  categories  of  programs. 
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CRES  Create/Maintain  Word  List  Flowcnart 
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CRES  Print  Word  List  Flowchart 


GENERATE 
WORD  LIST 
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CRES  Print  Word  List  by  Attribute  Flowchart 
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APPENDIX  D 

Sample  Text  Input  to  CRES 

The  honors  and  ceremonies  prescribed  in  these  regulations  may  be  dispensed 
with  when  directed  by  the  Secretary  of  the  Navy,  or  when  requested  by  an 
individual  to  whom  such  honors  and  ceremonies  are  due.  No  salute  shall  be 
fired  in  honor  of  any  nation  or  of  any  official  of  any  nation  not  formally 
recognized  by  the  Government  of  the  United  States;  and,  except  as  authorized 
by  the  Secretary  of  the  Navy,  no  other  honors  or  ceremonies  prescribed  in 
these  regulations  shall  be  rendered  or  exchanged  with  such  nations  or 
officials.  Should  the  required  number  or  frequency  of  international  salutes, 
official  visits,  or  other  honors  and  ceremonies  be  deemed  excessive,  the 
senior  officer  present  in  the  United  States  naval  service  may  make 
alterations,  subject  to  the  requirements  of  international  courtesy,  such 
modifications  as  circumstances  warrant  and  as  may  be  agreed  upon  with 
responsible  officials  or  the  senior  officer  present  of  the  nation  involved. 

The  National  Anthem  of  the  United  States,  "The  Star  Spangled  Banner",  when 
played  by  a  naval  band  shall  be  played  in  its  entirety  as  written  and  as 
prescribed  in  the  official  United  States  Navy  Band  arrangement  which  is 
designated  as  the  official  Department  of  Defense  arrangement.  The  playing  of 
the  National  Anthem  of  the  United  States,  or  of  any  other  country,  as  a  part 
of  a  medley  is  prohibited.  When  a  foreign  national  anthem  is  prescribed  in 
connection  with  honors,  and  it  is  considered  appropriate  to  perform  the 
National  Anthem  of  the  United  States  therewith,  the  National  Anthem  of  the 
United  States  shall  be  performed  last.  On  other  occasions  when  a  foreign 
national  anthem  (or  anthems)  is  performed,  the  National  Anthem  of  the  United 
States  will  be  performed  last,  except  when  performed  in  conjunction  with 
Morning  Colors. 

Whenever  the  National  Anthem  is  played,  all  naval  service  personnel  not  in 
formation  shall  stand  at  attention  and  face  the  national  ensign;  but  in  the 
event  that  the  national  ensign  is  not  being  displayed,  they  shall  face  the 
source  of  the  music.  When  covered  they  shall  come  to  the  salute  at  the  first 
note  of  the  anthem;  and  shall  remain  at  the  salute  until  the  last  note  of  the 
anthem.  Persons  in  formation  are  brought  to  order  arms  or  called  to  attention 
as  appropriate.  The  formation  commander  shall  face  in  the  direction  of  the 
ensign  or  in  the  absence  of  the  ensign  shall  face  in  the  direction  of  the 
music  and  shall  render  the  appropriate  salute  for  his  unit.  Persons  in 
formation  participating  in  a  ceremony  shall,  on  command,  follow  tne  procedure 
prescribed  for  the  ceremony.  Persons  in  vehicles  or  in  boats  shall  follow  tne 
procedure  prescribed  for  such  persons  during  colors;  persons  in  civilian 
clothes  shall  comply  with  the  rules  and  customs  established  for  civilians. 

The  same  marks  of  respect  prescribed  during  the  playing  of  the  National  Anthem 
shall  be  shown  during  the  playing  of  a  foreign  national  anthem.  The 
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ceremonial  hoisting  and  lowering  of  the  national  ensign  at  0800  and  sunset  at 
a  naval  command  ashore  or  aboard  a  ship  of  the  Navy  not  under  way  shall  De 
known  as  Morning  Colors  and  Evening  Colors,  respectively,  and  shall  be  carried 
out  as  prescribed  in  this  article.  The  guard  of  the  day  and  the  bands  shall 
be  paraded  in  the  vicinity  of  the  the  point  of  hoist  of  the  ensign. 

"Attention"  shall  be  sounded,  followed  by  the  playing  of  the  National  Anthem 
by  the  band.  At  Morning  Colors,  the  ensign  shall  be  started  up  at  the 
beginnning  of  the  music  and  hoisted  smartly  to  the  peak  or  truck.  At  Evening 
Colors,  the  ensign  shall  be  started  from  the  peak  or  truck  at  the  beginning  of 
the  music  and  the  lowering  so  regulated  as  to  be  completed  at  the  last  note. 

It  is  the  responsibility  of  transferring  activities  to  ensure  that  members 
acquire  obligated  service  necessary  for  tour  length  selected  by  the  member. 

If,  at  the  time  of  transfer,  a  member  is  undecided  as  to  which  tour 
(accompanied/all  others)  he/she  desires,  sufficient  obligated  service  to 
complete  the  "all  others"  tour  for  the  area  regardless  of  the  member's  pay 
grade  or  length  of  service,  personnel  ordered  to  an  overseas  activity 
(land-based  or  afloat)  shall  have  sufficient  obligated  service  to  ensure 
completion  of  the  appropriate  accompanied  tour  prescribed  for  the  area  to 
which  ordered  prior  to  execution  of  orders.  Attainment  of  obligated  service 
through  actual  reenlistment/extension  of  enlistment  is  required.  Page  13 
entry  for  attainment  of  obligated  service  is  prohibited.  Personnel 
approaching  fleet  reserve/retirement  eligibility.  Personnel  who  have 
completed  15  or  more  years  active  duty  for  the  period  of  time  required  to 
complete  the  applicable  tour  prescribed  for  the  overseas  area  to  which 
assigned.  Transfer  to  the  Fleet  Reserve  or  Retired  List  will  not  normally  be 
authorized  prior  to  completion  of  the  prescribed  overseas  tour.  Personnel 
approaching  retirement  eligibility  are  cautioned  of  the  fact  that  the 
requirement  to  complete  the  applicable  tour  for  the  overseas  area  may  disallow 
their  eligibility  to  request  a  twilight  tour.  Personnel  (other  than  CT,  OT, 
RM,  and  enlisted  women  in  those  ratings  listed  in  Article  3.181)  will  not 
normally  be  involuntarily  required  to  serve  consecutive  overseas  tours  unless 
Navy  requiremnts  (billet  priorities)  direct  such  action.  Personnel  assigned 
consecutive  overseas  tours  as  a  result  of  voluntary  action  will  be  required  to 
serve  the  appropriate  accompanied/all  others  tour  length. 
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CUES  Analysis  of  Sample  Text 

The  following  pages  contain  the  CRES  analysis  of  the  preceding  text.  The 
first  page  is  a  header,  which  is  printed  at  the  beginning  of  each  analysis. 
This  header  contains  ail  the  information  pertinent  to  the  particular 
analysis.  The  date  and  time  of  the  analysis,  any  title  specified,  the  name 
and  location  of  the  file  which  was  analyzed,  and  the  options  selected  for  the 
given  analysis  are  all  listed  for  future  reference.  Then  the  text  is  printed 
with  editorial  insertions  flagging  long  sentences  and  long  paragraphs,  with 
the  associated  word  or  sentence  count,  double  negatives,  passive  voice 
construction,  and  any  other  attributes  which  were  indicated  during  option 
selection.  Word  and  phrase  substitutes  are  included  in  parentheses  it  that 
option  was  specified.  At  the  conclusion  of  the  text  the  Reading  brade 
Analysis  is  printed  and  the  "uncommon"  words  encountered  in  the  text  are 
listed  in  alphabetical  order. 
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FLAG  LONG  PARAGRAPHS:  Y 

HOW  LONG?  WORDS  =  POO 


SENTENCES  =  10 
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The  honors  and  ceremonies  prescribed  in  these  regulations  may  be  dispensed 
K  PASSIVE  VOICE  *>  with  when  directed  by  the  Secretary  of  the  Navy,  or  when 
<£equested^X^  ASKED  by  an  individual  to  whom  such  honors  and  ceremonies 
are  due.^  34^  No  salute  shall  be  fired<^  PASSIVE  VOICE  in  honor  of  any 
nation  or  of  any  official  of  any  nation  not  [formally)  recognized  by  the 
Government  of  the  United  States  ;<*  27*><^  TOO  MANX  (  6)  PREPOSITIONS  ^ 

and,  except  as  authorized  by  the  Secretary  of  the  Navy,  no 

DOUBLE  NEGATIVE^  other  honors  or  ceremonies  prescribed  in  these 
regulations  shall  be  rendered  <*  GAVE/GIVEN  /  HADE  >><*  PASSIVE  VOICE  *>  or 
exchanged  with  such  nations  or  officials.^  29J>  Should  the 


required  \*  NEEDED  number  or  frequency  of  international  salutes, 
official  visits,  or  other  honors  and  ceremonies  be 
deemed  <*  THOUGHT  /  CONSIDERED  PASSIVE  VOICE^?>  excessive,  the  senior 

officer  present  in  the  United  States  naval  service  may  make  [alterations). 


subject  to  the  requirements  of  international  (courtesy],  such 
modifications  <?  CHANGES  as  circumstances  (warrant)  and  as  may  be  agreed 
PASSIVE  VOICE  *>  upon  with  responsible  officials  or  the  senior  officer 
present  of  the  nation  involved. <*  62^><^*  LIST?  The  National  Anthem  of  the 
United  States,  "The  Star  Spangled  Banner*,  when  played  by  a  naval  band  shall 
be  played  <**  PASSIVE  VOICE  in  its  [entirety]  as  written  and  as  prescribed 
in  the  official  United  States  Navy  Band  arrangement  which  is 
designated  <^*  SPECIFIED  /  CHOSEN  ^><*  PASSIVE  VOICE  >>  as  the  official 
Department  of  Defense  arrangement."^  46*>  The  playing  of  the  National  Anthem 
of  the  United  States,  or  of  any  other  country,  as  a  part  of  a  (medley)  is 
prohibited.^  23^><(*  PASSIVE  VOICE  When  a  foreign  national  anthem  is 
prescribed^  PASSIVE  VOICE  in  connection  with  <^*  WITH  /  ABOUT  ^honors. 
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and  it  is  considered  PASSIVE  VOICE  *>  appropriate  <•  PROPER  /  RIGHT  *>  to 
perform  the  National  Anthem  of  the  United  States  therewith,  WITH  the 
National  Anthem  of  the  United  States  shall  be  performed^  PASSIVE  VOICE 

✓  V. 

last. <£  37J-"  On  other  occasions  when  a  foreign  national  anthem  (or  anthems) 
is  performed,*^  PASSIVE  VOICE the  National  Anthem  of  the  United  States 
will  be  performed PASSIVE  VOICE  *>  last,  except  when  performed 
in  conjunction  with  <*  WITH  /  FOR  ^  Morning  Colors. 31^>  whenever  the 
National  Anthem  is  played,  <*^  PASSIVE  VOICE  *>  all  naval  service  personnel 
not  in  formation  shall  stand  at  attention  and  face  the  national  ensign) 

<*  23*-n  but  in  the  event  that  P*  IE  *>the  national  ensign  is  not  being 
displayed, PASSIVE  VOICE  p  they  shall  face  the  souRce  of  the  music.  When 
covered  they  shall  come  to  the  salute  at  the  first  note  of  the  anthem; 

<*  TOO  MANY  (  3)  PREPOSITIONS  p  and  shall  remain  STAY  *>  at  the  salute 

until  the  last  note  of  the  anthem.  TOO  MANY  (  3)  PREPOSITIONS  Persons 

in  formation  are  brought^  PASSIVE  VOICE  ^  to  order  arms  or  called  to 
attention  as  appropriate,  PROPER  /  RIGHT 

X*  TOO  MANY  (  3)  PREPOSITIONS  p  The  formation  commander  3hall  face  in 

the  direction  of  <*  DIRECTING  p the  ensign  or  in  the  absence  of  the  ensign 

/ 

shall  face  in  the  direction  of  <*  DIRECTING  p  the  music  and  shall 
render  p  GIVE  /  MAKE  p  the  appropriate  PROPER  /  RIGHT  "*>  salute  for 
his  unit.r^  35* 'X*  TOO  MANY  (  7)  PREPOSITIONS  Persons  in  formation 

participating  <4  TAKING  PART  p  in  a  ceremony  shall,  on  command,  follow  the 
procedure  prescr  ibed  for  the  ceremony. TOO  MANY  (  4)  PREPOSITIONS 

Persons  in  vehicles  or  in  boats  shall  follow  the  procedure  prescribed  for 
such  persons  during  colors; TOO  MANY  (  4)  PREPOSITIONS  persons  in 

civilian  clothes  3hall  comply  with  the  rules  and  customs 
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established  <*  SET  UP  /  PROVED  *>  for  civilians. 

TOO  MANY  (  3)  PREPOSITIONS^*  The  same  marks  of  respect  prescribed 

during  the  playing  of  the  National  Anthem  shall  be  shown^  PASSIVE  VOICE 

during  the  playing  of  a  foreign  national  anthem. 24*£> 

TOO  MANY  (  5)  PREPOSITIONS  The  [ceremonial)  hoisting  and  lowerinc.  of 

the  national  ensign  at  0800  and  sunset  at  a  naval  command  ashore  or  aboard  a 

ship  of  the  Navy  not  under  way  shall  be  known<^  PASSIVE  VOICE  as  Morning 

Colors  and  Evening  Colors,  (respectively),  and  shall  be  carried 

<!*  PASSIVE  VOICE  *>  out  as  prescribed  in  this  article.<*  48*>  The  guard  of 

the  day  and  the  bands  shall  be  [paraded]  in  the  vicinity  of  the  the  point  of 

hoist  of  the  ensign. <£  23*><*  TOO  MANY  (  5)  PREPOSITIONS  "Attention" 

shall  be  sounded,  PASSIVE  VOICE  *>  followed  by  the  playing  of  the  National 

Anthem  by  the  band.  <^TOO  MANY  (  3)  PREPOSITIONS  At  Morning  Colors,  the 

ensign  shall  be  started<^  PASSIVE  VOICE up  at  the  (beginnning)  of  the 

music  and  hoisted  smartly  to  the  peak  or  truck. 23*>  At  Evening  Colors, 

the  ensign  shall  be  started*^  PASSIVE  VOICE  £>  from  the  peak  or  truck  at  the 

beginning  of  the  music  and  the  lowering  so  regulated  as  to  ABOUT  ^>be 

completed^  PASSIVE  VOICE  at  the  last  note.<*  32^> 

/ 

<*  TOO  MANY  (  6)  PREPOSITIONS  1  It  is  the  responsibility  of  transferring 

activities  to  ensure  MAKE  SURE  that  members  [acquire] 
obligated  BOUND  /  COMPELLED  */''*  PASSIVE  VOICE  •>  service  necessary  for 
tour  length  selected  by  the  member.  235-><*^  TOO  MANY  (  5)  PREPOSITIONS 
If,  at  the  time  of  transfer,  a  member  is  [undecided]  as  to  xf  ABOUT  ♦'"which 
tour  [(accompanied/all]  others)  (he/she|  desires,  WANTS 
sufficient  <*  ENOUGH  £>  obligated  <*  BOUND  /  COMPELLED  service  to 
complete  the  "all  others"  tour  for  the  area  regardless  of  the  member's  pay 
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grade  or  length  of  service,  personnel  ordered  to  an  overseas  activity 

((land-based)  or  afloat)  shall  have  sufficient^*  ENOUGH  ^> 

obligated  <*  BOUND  /  COMPELLED  *>  service  to  ensure  MAKE  SURE 

completion  of  the  appropriate  PROPER  /  RIGHT  £> 

accompanied  <*^  WENT  WITH  )>  tour  prescribed  for  the  area  to  which  ordered 

prior  to  <*  BEFORE  £>  execution  of  <k  EXECUTING^  orders.<*  74*> 

<*  TOO  MANY  (  16)  PREPOSITIONS  *>  (Attainment]  of 

obligated  <•  BOUND  /  COMPELLED  service  through  (actual) 

(reenlistment/extension]  of  enlistment  is  required.  <C*  NEEDED  *> 

<*  PASSIVE  VOICE  TOO  MANY  (  3)  PREPOSITIONS  Page  13  entry  for 

(attainment)  of  ^obligated  BOUND  /  COMPELLED  *>  service  is  prohibited. 

*  PASSIVE  VOICE  *s  Personnel  approaching  fleet  (reserve/retirement) 

eligibility.  Personnel  who  have  completed  15  or  more  years  active  duty  for 

the  period  of  time  required  NEEDED to  complete  the  applicable  tour 

prescribed  for  the  overseas  area  to  which  assigned."^  29^> 

<*  TOO  MANY  (  6)  PREPOSITIONS  *>  Transfer  to  the  Pleet  Reserve  or  Retired 

List  will  not  normally  <*  TRY  TO  AVOID  *>  be  authorized^  PASSIVE  VOICE 

prior  to  <!)  BEFORE  ^completion  of  the  prescribed  overseas  tour.  Personnel 

/ 

approaching  retirement  eligibility  are  cautioned  <5*^  PASSIVE  VOICE  of  the 
fact  that  the  requirement  to  complete  the  applicable  tour  for  the  overseas 
area  may  (disallow]  their  eligibility  to  request  ASK  a  [twilight] 

tour.<*  i0*>  Personnel  (other  than  CT,  OT,  RM,  and  enlisted  women  in  those 
ratings  listed  in  Article  3.181)  will  not  normally  TRY  TO  AVOID  *>  be 
(involuntarilyl  required  <*  NEEDED  ^><*  PASSIVE  VOICE  _5>  to  serve 
consecutive  overseas  tours  unless  Navy  (requiremnts)  (billet  [priorities)  I 
direct  such  action.  <*^  35*>  Personnel  assigned  consecutive  overseas  tours 
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as  a  result  of  BECAUSE  /  EVEN  THOUGH^  [voluntary]  action  will  be  1 
required  <*  NEEDED  <*  PASSIVE  VOICE  to  serve  the  j 

i 

appropriate  <*  PROPER  /  RIGHT  [accompanied/all]  others  tour  length.  i 
S*  PARAGRAPH  TOO  LONG  (  33  SENTENCES  WITH  881  WORDS  )  *>  j 
<*  3.0%  PERSONAL  SENTENCES  *> 
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final  analysis 

-  READABILITY  RESULTS  - 

Number  of  Sentences  Number  of  Words  Number  of  Syllables 

33  881  1509 

Avg.  Number  of  Words  per  Sentence  Avg.  Number  of  Syllables  per  Word 
26.69  1.71 

Percent  of  Uncommon  Words  Percent  of  Long  Sentences 

3.06  60.60 

GRADE  LEVEL  (Based  on  DoD  Readability  Standard)  =  15.03 
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WORD 

Attainment 

accompanied/all 

acquire 

actual 

alterations 

attainment 

beg innning 

ceremonial 

courtesy 

disallow 

entirety 

formally 

he/she 


UNCOMMON  WORDS 


WORD 

involuntarily 

land-based 

medley 

paraded 

priorities 

reenlistment/extensi 

requiremnts 

reserve/retirement 

respectively 

twilight 

undecided 

voluntary 

warrant 
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WORD 

UNCOMMON 

FREQ 

WORDS  - 

WORD 

FREQ 

Attainment 

1 

involuntarily 

1 

accompanied/all 

2 

land-based 

1 

acquire 

1 

medley 

1 

actual 

1 

paraded 

1 

alterations 

1 

priorities 

1 

attainment 

1 

reenlistment/extensi 

1 

beginnning 

1 

requirerants 

1 

ceremonial 

1 

reserve/retireraent 

1 

courtesy 

1 

respectively 

1 

disallow 

1 

twilight 

1 

entirety 

1 

undecided 

1 

formally 

1 

voluntary 

1 

he/she 

1 

warrant 

1 
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